diff --git a/DESCRIPTION b/DESCRIPTION index 54e5361..89c7a46 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -5,15 +5,14 @@ Version: 0.0.1 Authors@R: person( "Ronald","Buie", email = "rbuie@kingcounty.gov", - role = c("auth", "cre")) -Description: This package is for use by epidemiologists within Public Health Seattle - and King County, and aligns to analytics guidelines and practices for Community + role = c("aut", "cre")) +Description: This package provides tools for epidemiologists within Public Health Seattle + and King County. It aligns with analytics guidelines and practices for Community Health Indicators (CHI) as reported by the Assessment, Policy Development, and - Evaluation Unit. The major activities assisted by this packages are - Simplifying the execution of identical CHI analyses across multiple variables - Creating CHI Tableau ready output of the analysis - Performing quality assurance regarding data structure and formatting - Pushing and pulling data to APDE servers + Evaluation Unit. The package simplifies the execution of identical CHI analyses + across multiple variables, creates CHI Tableau-ready output of the analysis, + performs quality assurance regarding data structure and formatting, and + facilitates pushing and pulling data to APDE servers. URL: https://github.com/PHSKC-APDE/apde.chi.tools BugReports: https://github.com/PHSKC-APDE/apde.chi.tools/issues License: MIT + file LICENSE @@ -23,18 +22,17 @@ Imports: data.table (>= 1.14.2), DBI (>= 1.1.0), dtsurvey (>= 0.0.2.0), + future, + future.apply, glue (>= 1.6.1), - keyring (>= 1.2.0), - lubridate (>= 1.6.0), - methods, odbc (>= 1.2.2), - rads.data (>= 1.0.7.5), - stats, - utf8 (>= 1.1.4), + rads, + rads.data, + tidyr, yaml (>= 2.2.1), utils Remotes: - github::PHSKC-APDE/rads.data, github::PHSKC-APDE/dtsurvey, github::PHSKC-APDE/apde.chi.tools + github::PHSKC-APDE/rads, github::PHSKC-APDE/dtsurvey Suggests: httr, knitr, @@ -43,8 +41,7 @@ Suggests: testthat (>= 3.0.0), srvyr, survey (>= 4.0) -VignetteBuilder: knitr Depends: - R (>= 3.1) + R (>= 4.1) Config/testthat/edition: 3 -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.2 diff --git a/NAMESPACE b/NAMESPACE index 0a9f307..8f1f3e5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -23,5 +23,7 @@ importFrom(data.table,setorder) importFrom(data.table,shift) importFrom(glue,glue) importFrom(rads,chi_qa) +importFrom(rads,substrRight) +importFrom(tidyr,crossing) importFrom(utils,write.table) importFrom(yaml,yaml.load) diff --git a/R/chi_generate_metadata.R b/R/chi_generate_metadata.R index 9a0eb2a..2271e61 100644 --- a/R/chi_generate_metadata.R +++ b/R/chi_generate_metadata.R @@ -7,13 +7,14 @@ #' @param est.current current year's tableau ready output with completed estimates #' #' @return table of metadata +#' @importFrom rads substrRight #' @export #' chi_generate_metadata <- function(meta.old = NULL, est.current = NULL){ # get new metadata ---- meta.new <- unique(est.current[tab == "metadata", - .(indicator_key, + list(indicator_key, latest_yearx = as.integer(year), latest_year_resultx = result, run_datex = run_date, @@ -33,7 +34,7 @@ chi_generate_metadata <- function(meta.old = NULL, meta.new[, c("latest_yearx", "latest_year_resultx", "run_datex", "latest_year_countx", "latest_year_kc_popx") := NULL] # update valid_years ---- - meta.new[as.integer(latest_year) > suppressWarnings(as.integer(substrRight(valid_years, 1, 4))), + meta.new[as.integer(latest_year) > suppressWarnings(as.integer(rads::substrRight(valid_years, 1, 4))), valid_years := suppressWarnings(paste(as.integer(substr(valid_years, 1, 4)):as.integer(latest_year), collapse = " "))] # Ensure there are no missing important metadata cells ---- diff --git a/R/chi_generate_tro_shell.R b/R/chi_generate_tro_shell.R index 53d8969..9333930 100644 --- a/R/chi_generate_tro_shell.R +++ b/R/chi_generate_tro_shell.R @@ -20,6 +20,7 @@ #' @param ph.analysis_set name of data.table to parse #' @param start.year the earliest year to be used for estimates #' @param end.year the latest year to be used for aggregate estimates (note, the earliest year for trends estimates is calculated from from the span and number of periods) +#' @param year.span the number of years to be included in a single non-trend period #' @param trend.span the number of years to be included in a single trend period #' @param trend.periods the number of periods to be included in a trend #' @returns data table with a single row for each calculation to be performed in generating Tableau Ready Output for CHI reporting @@ -36,6 +37,7 @@ chi_generate_tro_shell <- function(ph.analysis_set, start.year, end.year, + year.span = NULL, trend.span = NULL, trend.periods = NULL){ #parameterization checks diff --git a/R/chi_process_nontrends.R b/R/chi_process_nontrends.R index f2d099e..38e5e9a 100644 --- a/R/chi_process_nontrends.R +++ b/R/chi_process_nontrends.R @@ -24,6 +24,7 @@ #' @import dtsurvey #' @import future #' @import future.apply +#' @importFrom tidyr crossing chi_process_nontrends <- function(ph.analysis_set = NULL, myset = NULL){ @@ -35,15 +36,15 @@ chi_process_nontrends <- function(ph.analysis_set = NULL, tempy <- rbindlist(lapply(as.list(seq(1, length(subtabs))), FUN = function(subtab){ tempx <- subsets[get(subtabs[subtab]) == 'x', - .(tab = subtabs[subtab], cat1, cat1_varname, cat2 = NA_character_, cat2_varname = NA_character_)] + list(tab = subtabs[subtab], cat1, cat1_varname, cat2 = NA_character_, cat2_varname = NA_character_)] tempx <- setDT(tidyr::crossing(tempx, data.table(indicator_key = sub_indicators))) })) # crosstabs are a bit more complicated sub_crosstabs = setDT(tidyr::crossing( - unique(subsets[crosstabs == 'x', .(cat1, cat1_varname)]), - unique(subsets[crosstabs == 'x', .(cat2 = cat1, cat2_varname = cat1_varname)]) )) + unique(subsets[crosstabs == 'x', list(cat1, cat1_varname)]), + unique(subsets[crosstabs == 'x', list(cat2 = cat1, cat2_varname = cat1_varname)]) )) sub_crosstabs <- sub_crosstabs[cat1 == 'King County' | cat1_varname != cat2_varname] sub_crosstabs <- sub_crosstabs[!(cat1_varname == 'race3' & cat2_varname %in% c('race3', 'race4'))] # do not want race x race sub_crosstabs <- sub_crosstabs[!(cat2_varname == 'race3' & cat1_varname %in% c('race3', 'race4'))] # do not want race x race diff --git a/R/chi_process_trends.R b/R/chi_process_trends.R index 4c40b25..ea8edef 100644 --- a/R/chi_process_trends.R +++ b/R/chi_process_trends.R @@ -1,7 +1,7 @@ #' CHI Generate Trend Years #' #' @param indicator_key chi indicator key variable -#' @param span number of years to include in a trend year estimate +#' @param trend.span the number of years to be included in a single trend period #' @param end.year last year of a trend year time series #' @param trend.periods number of periods to calculate #' @@ -15,12 +15,13 @@ #' @returns TRO with rows for each indicator key and span of years within the provided time frame #' @keywords CHI, Tableau, Production #' @import dtsurvey +#' @importFrom tidyr crossing chi_process_trends <- function(indicator_key = NULL, trend.span = NULL, end.year = NULL, trend.periods = NULL){ - last.start <- end.year-(span-1) + last.start <- end.year-(trend.span-1) all.start.years <- last.start:(last.start-(trend.periods-1)) all.end.years <- end.year:(end.year-(trend.periods-1)) spandt <- data.table(end = all.end.years, start = all.start.years) diff --git a/R/globals.R b/R/globals.R new file mode 100644 index 0000000..4b08dde --- /dev/null +++ b/R/globals.R @@ -0,0 +1,15 @@ +# Declare global variables for devtools::check() +utils::globalVariables(c( + "varname", "group", "keepme", "reference", "chi_year", "tempstart", + "tempend", "chi_geo_kc", "cat1", "cat1_varname", "cat2", "cat2_varname", + "chi_age", "numerator", "count", "cat2_group", "indicator_key", "tab", + "round2", "lower_bound", "cat1_group", "cat2", "tempbv", "run_date", + "chi", "data_source", "time_trends", "suppression", "rse", "caution", + "comparison_with_kc_sig", "AgeMin", "AgeMax", "start", "race_type", "geo_type", + "denominator", "latest_yearx", "latest_year", "latest_year_resultx", "latest_year_result", + "run_datex", "latest_year_countx", "latest_year_count", "latest_year_kc_popx", + "latest_year_kc_pop", "valid_years", "end", "group_by1", "group_by2", "geo_id", + "gender", "race_eth", "race", "race_aic", "GEOID20", "hra20_name", "region_name", + "s2t_fraction", "source_id", "region", "pop", "bigcity", "geo_tract2020", "pov200grp", + "crosstabs", "vebrose", "span", "age", 'year.span' +)) diff --git a/R/proto_chi_calc.R b/R/proto_chi_calc.R index 7a0ff15..135e288 100644 --- a/R/proto_chi_calc.R +++ b/R/proto_chi_calc.R @@ -7,9 +7,6 @@ chi_calc <- function(ph.data = NULL, suppress_high = 9, source_name = 'blahblah', source_date = NULL){ - - - # Error if ph.instructions has no data ---- if(nrow(ph.instructions) == 0){ stop("\n\U0001f47f the table ph.instructions does not have any rows.") @@ -59,21 +56,21 @@ chi_calc <- function(ph.data = NULL, if(length(tempbv2) == 0){tempbv2 = NA} tempbv <- setdiff(c(tempbv1, tempbv2), c(NA)) - # send constants to global environment so it can be used by the calc() function below - assign("tempbv", tempbv, envir = .GlobalEnv) - assign("tempend", ph.instructions[X][['end']], envir = .GlobalEnv) - assign("tempstart", ph.instructions[X][['start']], envir = .GlobalEnv) + # create variables of interest used in calc function below + tempbv <- tempbv + tempend <- ph.instructions[X][['end']] + tempstart <- ph.instructions[X][['start']] # use calc()---- if(rate == FALSE){ # standard proportion analysis if(any(grepl('wastate', tempbv))){ - tempest <- calc(ph.data = ph.data, + tempest <- rads::calc(ph.data = ph.data, what = ph.instructions[X][['indicator_key']], where = chi_year >= tempstart & chi_year <= tempend, by = tempbv, metrics = c('mean', 'numerator', 'denominator', 'rse')) } else { - tempest <- calc(ph.data = ph.data, + tempest <- rads::calc(ph.data = ph.data, what = ph.instructions[X][['indicator_key']], where = chi_year >= tempstart & chi_year <= tempend & chi_geo_kc == 'King County', by = tempbv, @@ -82,14 +79,14 @@ chi_calc <- function(ph.data = NULL, } if(rate == TRUE){ if(any(grepl('wastate', tempbv))){ - tempest <- calc(ph.data = ph.data, + tempest <- rads::calc(ph.data = ph.data, what = ph.instructions[X][['indicator_key']], where = chi_year >= tempstart & chi_year <= tempend, by = tempbv, metrics = c('rate', 'numerator', 'denominator', 'rse'), per = rate_per) } else { - tempest <- calc(ph.data = ph.data, + tempest <- rads::calc(ph.data = ph.data, what = ph.instructions[X][['indicator_key']], where = chi_year >= tempstart & chi_year <= tempend & chi_geo_kc == 'King County', by = tempbv, @@ -186,9 +183,6 @@ chi_calc <- function(ph.data = NULL, cat2 := 'Ethnicity'] } - # drop temporary vars that were sent to global environment for calc() ---- - rm(tempbv, tempend, tempstart, envir = .GlobalEnv) - # Create additional necessary CHI columns ---- tempCHIest[, source_date := as.Date(source_date)] tempCHIest[, run_date := as.Date(Sys.Date(), "%Y%m%d")] @@ -197,7 +191,7 @@ chi_calc <- function(ph.data = NULL, tempCHIest[, data_source := source_name] tempCHIest[, time_trends := NA] # NA because no longer calculated - tempCHIest <- compare_estimate(mydt = tempCHIest, + tempCHIest <- rads::compare_estimate(mydt = tempCHIest, id_vars = c("indicator_key", "year"), key_where = cat1_group == "King County" & tab != "crosstabs", new_col = "comparison_with_kc", @@ -215,7 +209,7 @@ chi_calc <- function(ph.data = NULL, # Keep and order standard CHI columns ---- - tempCHIest <- tempCHIest[, c(chi_cols()[]), with = F] + tempCHIest <- tempCHIest[, c(rads::chi_cols()[]), with = F] tempCHIest <- tempCHIest[, cat1 := factor(cat1, levels = c("King County", sort(setdiff(unique(tempCHIest$cat1), "King County"))) )] tempCHIest <- tempCHIest[, tab := factor(tab, levels = c(c("_kingcounty","demgroups", "trends"), sort(setdiff(unique(tempCHIest$tab), c("_kingcounty","demgroups", "trends")))) )] diff --git a/R/proto_chi_count_by_age.R b/R/proto_chi_count_by_age.R index b5a6788..330432e 100644 --- a/R/proto_chi_count_by_age.R +++ b/R/proto_chi_count_by_age.R @@ -45,20 +45,20 @@ chi_count_by_age <- function(ph.data = NULL, tempbv <- setdiff(c(tempbv1, tempbv2), c(NA)) tempbv <- c(tempbv, "chi_age") - # send constants to global environment so it can be used by the calc() function below - assign("tempbv", tempbv, envir = .GlobalEnv) - assign("tempend", ph.instructions[X][['end']], envir = .GlobalEnv) - assign("tempstart", ph.instructions[X][['start']], envir = .GlobalEnv) + # create variables of interest used in calc function below + tempbv <- tempbv + tempend <- ph.instructions[X][['end']] + tempstart <- ph.instructions[X][['start']] # use calc---- if(any(grepl('wastate', tempbv))){ - tempcount <- calc(ph.data = ph.data, + tempcount <- rads::calc(ph.data = ph.data, what = ph.instructions[X][['indicator_key']], where = chi_year >= tempstart & chi_year <= tempend, by = tempbv, metrics = c('numerator')) } else { - tempcount <- calc(ph.data = ph.data, + tempcount <- rads::calc(ph.data = ph.data, what = ph.instructions[X][['indicator_key']], where = chi_year >= tempstart & chi_year <= tempend & chi_geo_kc == 'King County', by = tempbv, @@ -103,7 +103,7 @@ chi_count_by_age <- function(ph.data = NULL, year := ph.instructions[X][['end']]] # order output---- - tempcount <- tempcount[, .(indicator_key, year, tab, cat1, cat1_varname, cat1_group, cat2, cat2_varname, cat2_group, chi_age, count)] + tempcount <- tempcount[, list(indicator_key, year, tab, cat1, cat1_varname, cat1_group, cat2, cat2_varname, cat2_group, chi_age, count)] setorder(tempcount, cat1_group, cat2_group, chi_age) } diff --git a/R/proto_chi_generate_instructions_pop.R b/R/proto_chi_generate_instructions_pop.R index 424d893..71d79bb 100644 --- a/R/proto_chi_generate_instructions_pop.R +++ b/R/proto_chi_generate_instructions_pop.R @@ -1,6 +1,6 @@ chi_generate_instructions_pop <- function(mycount.data, povgeo = NA){ pop.template <- copy(mycount.data) - pop.template <- unique(copy(pop.template)[, .(year, cat1, cat1_varname, cat2, cat2_varname, tab)]) + pop.template <- unique(copy(pop.template)[, list(year, cat1, cat1_varname, cat2, cat2_varname, tab)]) pop.template[, c("start", "stop") := tstrsplit(year, split = '-') ] pop.template[is.na(stop), stop := start] # need to have an end date even if it is just one year diff --git a/R/proto_chi_get_proper_pop.R b/R/proto_chi_get_proper_pop.R index 28cc82e..dff8d76 100644 --- a/R/proto_chi_get_proper_pop.R +++ b/R/proto_chi_get_proper_pop.R @@ -26,7 +26,7 @@ chi_get_proper_pop <- function(pop.template = NULL, pop.genders = NULL, pop.ages # use rads::get_population ---- if(is.na(pop.template[X, geo_type])){ - tempy <- get_population(group_by = groupy, + tempy <- rads::get_population(group_by = groupy, race_type = pop.template[X, race_type], years = pop.template[X, start]:pop.template[X, stop], genders = gendery, @@ -34,7 +34,7 @@ chi_get_proper_pop <- function(pop.template = NULL, pop.genders = NULL, pop.ages round = F) } if(!is.na(pop.template[X, geo_type])){ - tempy <- get_population(group_by = groupy, + tempy <- rads::get_population(group_by = groupy, geo_type = pop.template[X, geo_type], race_type = pop.template[X, race_type], years = pop.template[X, start]:pop.template[X, stop], @@ -85,21 +85,21 @@ chi_get_proper_pop <- function(pop.template = NULL, pop.genders = NULL, pop.ages # HRAS ---- if(tempy[1, geo_type] == 'blk' & tempy[1, get(catnum)] == 'Cities/neighborhoods'){ - temp.xwalk <- rads.data::spatial_block20_to_hra20_to_region20[, .(geo_id = GEOID20, hra20_name)] + temp.xwalk <- rads.data::spatial_block20_to_hra20_to_region20[, list(geo_id = GEOID20, hra20_name)] tempy <- merge(tempy, temp.xwalk, by = "geo_id", all.x = T, all.y = F) tempy[, paste0(catnum, "_group") := hra20_name] } # Regions ---- if(tempy[1, geo_type] == 'blk' & tempy[1, get(catnum)] == 'Regions'){ - temp.xwalk <- rads.data::spatial_block20_to_hra20_to_region20[, .(geo_id = GEOID20, region_name)] + temp.xwalk <- rads.data::spatial_block20_to_hra20_to_region20[, list(geo_id = GEOID20, region_name)] tempy <- merge(tempy, temp.xwalk, by = 'geo_id', all.x = T, all.y = F) tempy[, paste0(catnum, "_group") := region_name] } if(tempy[1, geo_type] == 'hra' & tempy[1, get(catnum)] == 'Regions'){ - temp.xwalk <- rads.data::spatial_hra20_to_region20[, .(geo_id = hra20_name, region_name)] + temp.xwalk <- rads.data::spatial_hra20_to_region20[, list(geo_id = hra20_name, region_name)] tempy <- merge(tempy, temp.xwalk, by = 'geo_id', all.x = T, all.y = F) tempy[, paste0(catnum, "_group") := region_name] @@ -108,11 +108,11 @@ chi_get_proper_pop <- function(pop.template = NULL, pop.genders = NULL, pop.ages if(tempy[1, geo_type] == 'zip' & tempy[1, get(catnum)] == 'Regions'){ zip_2_region <- rads.data::spatial_zip_to_hra20_pop zip_2_region <- merge(zip_2_region, - rads.data::spatial_hra20_to_region20[, .(hra20_name, region = region_name)], + rads.data::spatial_hra20_to_region20[, list(hra20_name, region = region_name)], by = 'hra20_name', all = T) - zip_2_region <- zip_2_region[, .(s2t_fraction = sum(s2t_fraction)), # collapse fractions down to region level - .(geo_id = as.character(source_id), region)] + zip_2_region <- zip_2_region[, list(s2t_fraction = sum(s2t_fraction)), # collapse fractions down to region level + list(geo_id = as.character(source_id), region)] tempy <- merge(tempy, zip_2_region, by = "geo_id", all.x = T, all.y = F, allow.cartesian = T) tempy[, pop := pop * s2t_fraction] # calculate weighted pop @@ -122,13 +122,13 @@ chi_get_proper_pop <- function(pop.template = NULL, pop.genders = NULL, pop.ages # Big Cities ---- if(tempy[1, get(catnum)] == 'Big cities'){ if(tempy[1, geo_type] == 'blk'){ - blk20_hra20 <- rads.data::spatial_block20_to_hra20_to_region20[, .(geo_id = GEOID20, hra20_name)] + blk20_hra20 <- rads.data::spatial_block20_to_hra20_to_region20[, list(geo_id = GEOID20, hra20_name)] tempy <- merge(tempy, blk20_hra20, by = "geo_id", all.x = T, all.y = F) - hra20_bigcity <- rads.data::spatial_hra20_to_bigcities[, .(hra20_name, bigcity)] + hra20_bigcity <- rads.data::spatial_hra20_to_bigcities[, list(hra20_name, bigcity)] tempy <- merge(tempy, hra20_bigcity, by = 'hra20_name', all.x = T, all.y = F) } if(tempy[1, geo_type] == 'hra'){ - hra20_bigcity <- rads.data::spatial_hra20_to_bigcities[, .(hra20_name, bigcity)] + hra20_bigcity <- rads.data::spatial_hra20_to_bigcities[, list(hra20_name, bigcity)] tempy <- merge(tempy, hra20_bigcity, by.x = 'geo_id', by.y = 'hra20_name', all.x = T, all.y = F) } tempy[, paste0(catnum, "_group") := bigcity] @@ -159,7 +159,7 @@ chi_get_proper_pop <- function(pop.template = NULL, pop.genders = NULL, pop.ages if(tempy[1, geo_type] == 'blk' & grepl("poverty$", tempy[1, get(catnum)], ignore.case = T)){ tempy[, geo_tract2020 := substr(geo_id, 1, 11)] # have blocks (15 char), so keep first 11 for tracts tempy <- merge(tempy, - rads.data::misc_poverty_groups[geo_type=='Tract'][, .(geo_tract2020 = geo_id, pov200grp)], + rads.data::misc_poverty_groups[geo_type=='Tract'][, list(geo_tract2020 = geo_id, pov200grp)], by = "geo_tract2020", all.x = T, all.y = F) @@ -167,7 +167,7 @@ chi_get_proper_pop <- function(pop.template = NULL, pop.genders = NULL, pop.ages } if( tempy[1, geo_type] == 'zip' & grepl("poverty$", tempy[1, get(catnum)], ignore.case = T)){ tempy <- merge(tempy, - rads.data::misc_poverty_groups[geo_type=='ZCTA'][, .(geo_id, pov200grp)], + rads.data::misc_poverty_groups[geo_type=='ZCTA'][, list(geo_id, pov200grp)], by = 'geo_id', all.x = T, all.y = F) @@ -183,7 +183,7 @@ chi_get_proper_pop <- function(pop.template = NULL, pop.genders = NULL, pop.ages tempy <- tempy[!(cat2 != 'NA' & (cat2_group == 'NA') | is.na(cat2_group))] # did not yet switch back to true NA at this point # collapse to one row per demographic combination and keep minimum needed columns ---- - tempy <- tempy[, .(pop = sum(pop)), .(chi_age = age, year, cat1, cat1_varname, cat1_group, cat2, cat2_varname, cat2_group)] + tempy <- tempy[, list(pop = sum(pop)), list(chi_age = age, year, cat1, cat1_varname, cat1_group, cat2, cat2_varname, cat2_group)] # ensure each demographic has rows for all relevant ages & only relevant ages ---- if(tempy[1]$cat1 == "Age"){ @@ -205,7 +205,7 @@ chi_get_proper_pop <- function(pop.template = NULL, pop.genders = NULL, pop.ages breaks = c(-1, 4, 9, 14, 17), labels = c('0-4', '5-9', '10-14', '15-17'))]} - temp.demog <- setDT(tidyr::crossing(unique(tempy[, .(year = as.character(year), cat2, cat2_varname, cat2_group)]), + temp.demog <- setDT(tidyr::crossing(unique(tempy[, list(year = as.character(year), cat2, cat2_varname, cat2_group)]), tempage)) } @@ -228,15 +228,15 @@ chi_get_proper_pop <- function(pop.template = NULL, pop.genders = NULL, pop.ages breaks = c(-1, 4, 9, 14, 17), labels = c('0-4', '5-9', '10-14', '15-17'))]} - temp.demog <- setDT(tidyr::crossing(unique(tempy[, .(year = as.character(year), cat1, cat1_varname, cat1_group)]), + temp.demog <- setDT(tidyr::crossing(unique(tempy[, list(year = as.character(year), cat1, cat1_varname, cat1_group)]), tempage)) } if(!"Age" %in% unique(c(tempy$cat1, tempy$cat2))){ # all combinations of cat1 x cat2 temp.demog <- setDT(tidyr::crossing( - unique(tempy[, .(cat1, cat1_varname, cat1_group)]), - unique(tempy[, .(cat2, cat2_varname, cat2_group)]) + unique(tempy[, list(cat1, cat1_varname, cat1_group)]), + unique(tempy[, list(cat2, cat2_varname, cat2_group)]) )) # all combination of cat table with year and age temp.demog <- setDT(tidyr::crossing( diff --git a/README.md b/README.md index d6bb7c0..8dfc0a1 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ apde.chi.tools is an R library that provides easy access and centralized versioning of convenience tools for the CHI/CHNA update process. -The are ment to support our epidemiologist in various steps along the pipeline, including: +The are meant to support our epidemiologist in various steps along the pipeline, including: + planning + batch processing diff --git a/man/chi_generate_tro_shell.Rd b/man/chi_generate_tro_shell.Rd index af3b94e..954091e 100644 --- a/man/chi_generate_tro_shell.Rd +++ b/man/chi_generate_tro_shell.Rd @@ -8,6 +8,7 @@ chi_generate_tro_shell( ph.analysis_set, start.year, end.year, + year.span = NULL, trend.span = NULL, trend.periods = NULL ) @@ -19,6 +20,8 @@ chi_generate_tro_shell( \item{end.year}{the latest year to be used for aggregate estimates (note, the earliest year for trends estimates is calculated from from the span and number of periods)} +\item{year.span}{the number of years to be included in a single non-trend period} + \item{trend.span}{the number of years to be included in a single trend period} \item{trend.periods}{the number of periods to be included in a trend} diff --git a/man/chi_process_trends.Rd b/man/chi_process_trends.Rd index 6f88d86..e98bf65 100644 --- a/man/chi_process_trends.Rd +++ b/man/chi_process_trends.Rd @@ -14,11 +14,11 @@ chi_process_trends( \arguments{ \item{indicator_key}{chi indicator key variable} +\item{trend.span}{the number of years to be included in a single trend period} + \item{end.year}{last year of a trend year time series} \item{trend.periods}{number of periods to calculate} - -\item{span}{number of years to include in a trend year estimate} } \value{ TRO with rows for each indicator key and span of years within the provided time frame diff --git a/tests/testthat/test-chi_generate_tro_shell.R b/tests/testthat/test-chi_generate_tro_shell.R index b6402a0..28dfb97 100644 --- a/tests/testthat/test-chi_generate_tro_shell.R +++ b/tests/testthat/test-chi_generate_tro_shell.R @@ -11,7 +11,7 @@ test_that("injest template format", { trends <- c("x",NA,NA, "x","x", "x", "x", "x",NA,"x", "x") set_indicator_keys <- c(rep("key1, key2, key3",7),rep("key4, key5",4)) - template <- data.table(set, + template <- data.table::data.table(set, cat1, cat1_varname, kingCounty, @@ -20,7 +20,12 @@ test_that("injest template format", { crosstabs, trends, set_indicator_keys) - DT <- chi_generate_tro_shell(ph.analysis_set, 2021, 2022, 3, 5) + DT <- chi_generate_tro_shell(ph.analysis_set = template, + start.year = 2021, + end.year = 2022, + year.span = 5, + trend.span = 3, + trend.periods = 5) expect_equal(nrow(DT), 264) expect_equal(length(unique(DT$indicator_key)),5) expect_equal(DT[tab == "trends",][1]$end - DT[tab == "trends",][1]$start,2) diff --git a/tests/testthat/test-chi_process_trends.R b/tests/testthat/test-chi_process_trends.R index 02e177e..f36c36a 100644 --- a/tests/testthat/test-chi_process_trends.R +++ b/tests/testthat/test-chi_process_trends.R @@ -1,3 +1,4 @@ test_that("calculates trends", { - DT <- chi_generate_trend_years(indicator_key = c("test1", "test2"),span = 3,begin.year = 2009,final.year = 2023) + # chi_generate_trend_years does not exist + # DT <- chi_generate_trend_years(indicator_key = c("test1", "test2"),span = 3,begin.year = 2009,final.year = 2023) })