From 0a981e52f072fca79e43439bef76843ff7c436dd Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Fri, 17 Jun 2022 12:34:14 -0400 Subject: [PATCH 1/4] county metadata --- facebook/delphiFacebook/DESCRIPTION | 2 +- facebook/delphiFacebook/NAMESPACE | 2 + facebook/delphiFacebook/R/contingency_write.R | 50 +++++++++++++++++-- 3 files changed, 48 insertions(+), 6 deletions(-) diff --git a/facebook/delphiFacebook/DESCRIPTION b/facebook/delphiFacebook/DESCRIPTION index c42da0224..beda72167 100644 --- a/facebook/delphiFacebook/DESCRIPTION +++ b/facebook/delphiFacebook/DESCRIPTION @@ -30,5 +30,5 @@ Suggests: testthat (>= 1.0.1), covr (>= 2.2.2) LinkingTo: Rcpp -RoxygenNote: 7.1.1 +RoxygenNote: 7.2.0 Encoding: UTF-8 diff --git a/facebook/delphiFacebook/NAMESPACE b/facebook/delphiFacebook/NAMESPACE index cfef1c937..4416f8e45 100644 --- a/facebook/delphiFacebook/NAMESPACE +++ b/facebook/delphiFacebook/NAMESPACE @@ -69,6 +69,7 @@ importFrom(dplyr,bind_rows) importFrom(dplyr,case_when) importFrom(dplyr,coalesce) importFrom(dplyr,desc) +importFrom(dplyr,distinct) importFrom(dplyr,everything) importFrom(dplyr,filter) importFrom(dplyr,full_join) @@ -121,6 +122,7 @@ importFrom(stringi,stri_split) importFrom(stringi,stri_sub) importFrom(stringi,stri_trans_tolower) importFrom(stringi,stri_trim) +importFrom(stringr,str_pad) importFrom(survey,oldsvyquantile) importFrom(survey,svydesign) importFrom(survey,svymean) diff --git a/facebook/delphiFacebook/R/contingency_write.R b/facebook/delphiFacebook/R/contingency_write.R index 58aca8a92..da2d33d1b 100644 --- a/facebook/delphiFacebook/R/contingency_write.R +++ b/facebook/delphiFacebook/R/contingency_write.R @@ -23,7 +23,6 @@ #' @export write_contingency_tables <- function(data, params, geo_type, groupby_vars, theme = NULL) { if (!is.null(data) && nrow(data) != 0) { - # Reorder the group-by columns and sort the dataset by them. groupby_vars <- c("geo_id", sort(setdiff(groupby_vars, "geo_id"))) data <- data %>% @@ -61,8 +60,9 @@ write_contingency_tables <- function(data, params, geo_type, groupby_vars, theme #' @param params A parameters object with the `static_dir` resources folder. #' @param geo_type "nation", "state". #' -#' @importFrom dplyr bind_cols left_join select +#' @importFrom dplyr bind_cols left_join select distinct mutate #' @importFrom readr read_csv cols +#' @importFrom stringr str_pad #' @noRd add_geo_vars <- function(data, params, geo_type) { @@ -75,7 +75,6 @@ add_geo_vars <- function(data, params, geo_type) { ) if (geo_type == "nation") { - rest <- data.frame( region = overall, GID_1 = NA_character_, @@ -86,7 +85,6 @@ add_geo_vars <- function(data, params, geo_type) { ) } else if (geo_type == "state") { - states <- read_csv( file.path(params$static_dir, "state_list.csv"), col_types = cols(.default = "c") @@ -109,7 +107,49 @@ add_geo_vars <- function(data, params, geo_type) { .data$county_fips ) } else if (geo_type == "county") { - warning("county metadata not supported") + counties <- read_csv( + file.path(params$static_dir, "02_20_uszips.csv"), + col_types = cols(.default = "c") + ) %>% + mutate( + fips = str_pad(.data$fips, 5, pad="0") + ) %>% + select(fips, county_name, state_id, state_name) %>% + distinct() + + rest <- data.frame( + county_fips = data$geo_id + ) + + rest <- left_join(rest, counties, by = c("county_fips" = "fips")) %>% + mutate( + region = .data$state_id, + state = .data$state_id, + county = .data$county_name, + county_fips = .data$county_fips + ) %>% + select( + .data$region, + .data$state, + .data$county, + .data$county_fips + ) + + # Fill in state fips and GID_1 + states <- read_csv( + file.path(params$static_dir, "state_list.csv"), + col_types = cols(.default = "c") + ) + + rest <- left_join(rest, states, by = "state") %>% + select( + .data$region, + .data$GID_1, + .data$state, + .data$state_fips, + .data$county, + .data$county_fips + ) } geo_vars <- bind_cols(first, rest) From dd384ffb6e0bcbe0a62052bde71b9a6996da2046 Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Wed, 22 Jun 2022 17:01:12 -0400 Subject: [PATCH 2/4] swap stringr for stringi --- facebook/delphiFacebook/NAMESPACE | 2 +- facebook/delphiFacebook/R/contingency_write.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/facebook/delphiFacebook/NAMESPACE b/facebook/delphiFacebook/NAMESPACE index 4416f8e45..1890f72ee 100644 --- a/facebook/delphiFacebook/NAMESPACE +++ b/facebook/delphiFacebook/NAMESPACE @@ -116,13 +116,13 @@ importFrom(stats,setNames) importFrom(stats,weighted.mean) importFrom(stringi,stri_extract) importFrom(stringi,stri_extract_first) +importFrom(stringi,stri_pad) importFrom(stringi,stri_replace) importFrom(stringi,stri_replace_all) importFrom(stringi,stri_split) importFrom(stringi,stri_sub) importFrom(stringi,stri_trans_tolower) importFrom(stringi,stri_trim) -importFrom(stringr,str_pad) importFrom(survey,oldsvyquantile) importFrom(survey,svydesign) importFrom(survey,svymean) diff --git a/facebook/delphiFacebook/R/contingency_write.R b/facebook/delphiFacebook/R/contingency_write.R index da2d33d1b..01f2346a2 100644 --- a/facebook/delphiFacebook/R/contingency_write.R +++ b/facebook/delphiFacebook/R/contingency_write.R @@ -62,7 +62,7 @@ write_contingency_tables <- function(data, params, geo_type, groupby_vars, theme #' #' @importFrom dplyr bind_cols left_join select distinct mutate #' @importFrom readr read_csv cols -#' @importFrom stringr str_pad +#' @importFrom stringi stri_pad #' @noRd add_geo_vars <- function(data, params, geo_type) { @@ -112,7 +112,7 @@ add_geo_vars <- function(data, params, geo_type) { col_types = cols(.default = "c") ) %>% mutate( - fips = str_pad(.data$fips, 5, pad="0") + fips = stri_pad(.data$fips, 5, pad="0") ) %>% select(fips, county_name, state_id, state_name) %>% distinct() From 6760ce3ec7f0917fcb20f054a806b0fe78aa4435 Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Fri, 24 Jun 2022 18:43:36 -0400 Subject: [PATCH 3/4] retain field names when adding geo info --- facebook/delphiFacebook/R/contingency_write.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/facebook/delphiFacebook/R/contingency_write.R b/facebook/delphiFacebook/R/contingency_write.R index 01f2346a2..93ebe5d4a 100644 --- a/facebook/delphiFacebook/R/contingency_write.R +++ b/facebook/delphiFacebook/R/contingency_write.R @@ -157,7 +157,12 @@ add_geo_vars <- function(data, params, geo_type) { # Insert the geographic variables in place of the "geo_id" variable. index <- which(names(data) == "geo_id") before <- if (index > 1) data[, 1:(index-1)] else NULL - after <- data[, (index+1):ncol(data)] + + if (ncol(data) == 1) { + after <- NULL + } else { + after <- select(data, (index+1):ncol(data)) + } result <- bind_cols(before, geo_vars, after) return(result) From 78c8d4d78fd52709ec84fac82c30b47dea708e65 Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Mon, 27 Jun 2022 16:13:27 -0400 Subject: [PATCH 4/4] combine select and mutate --- facebook/delphiFacebook/R/contingency_write.R | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/facebook/delphiFacebook/R/contingency_write.R b/facebook/delphiFacebook/R/contingency_write.R index 93ebe5d4a..eb6c2ec89 100644 --- a/facebook/delphiFacebook/R/contingency_write.R +++ b/facebook/delphiFacebook/R/contingency_write.R @@ -122,17 +122,11 @@ add_geo_vars <- function(data, params, geo_type) { ) rest <- left_join(rest, counties, by = c("county_fips" = "fips")) %>% - mutate( + select( region = .data$state_id, state = .data$state_id, county = .data$county_name, county_fips = .data$county_fips - ) %>% - select( - .data$region, - .data$state, - .data$county, - .data$county_fips ) # Fill in state fips and GID_1