Merge branch 'development' of https://github.com/UI-Research/gates-mo…

…bility-metrics-pages into development

.gitignore

@@ -10,3 +10,5 @@ rfi-applicants-brief.xlsx
 rfi-applicants.xlsx
 
 /.quarto/
+factsheets/999_county-pages/
+factsheets/998_place-pages/

R/config.R

@@ -0,0 +1,21 @@
+#Config script
+
+
+install.packages("tidyverse")
+install.packages("here")
+install.packages("gt")
+install.packages("qdapRegex")
+install.packages("tictoc")
+install.packages("quarto")
+install.packages("tidycensus")
+install.packages("future")
+install.packages("furrr")
+install.packages("aws.s3")
+
+if(!(dir.exists("factsheets/999_county-pages"))){
+  dir.create("factsheets/999_county-pages")
+} 
+
+if(!(dir.exists("factsheets/998_place-pages"))){
+  dir.create("factsheets/998_place-pages")
+}

R/create_standard_county_df.R

@@ -7,7 +7,8 @@
 library(tidyverse)
 library(tidycensus)
 
-if(!(file.exists("data/100_all-counties.Rda"))){
+if(!file.exists("data/999_all-counties.Rda")) {
+
   county_geoids <- get_acs(geography = "county", 
                            variable = "B01001A_001", 
                            year = 2021) 
@@ -17,18 +18,23 @@ if(!(file.exists("data/100_all-counties.Rda"))){
     mutate(state_title = list(state_title = FALSE),
            geoid = str_c(geoid, ";"),
            geoid = strsplit(geoid, ";")
-    )
+    ) %>%
+    filter(str_sub(geoid, 1, 2) != "72")
 
   geoid_lst <- as.list(prepped_counties$geoid)
 
-  prepped_counties <- tibble(filename = "index.html", 
+  prepped_counties <- tibble(filename = "index.html",
                              params = map(geoid_lst, 
                                           ~list(state_county = ., 
                                                 state_title = FALSE)
                                           ),
-                             dir_name = str_c("factsheets/", geoid_lst, "/")
+                             dir_name = str_c("factsheets/999_county-pages/", geoid_lst, "/")
   )
-  save(prepped_counties, file = "data/100_all-counties.Rda")
-} else{
-  load("data/100_all-counties.Rda")
+
+  save(prepped_counties, file = "data/999_all-counties.Rda")
+
+} else {
+
+  load("data/999_all-counties.Rda")
+
 }

R/create_standard_place_df.R

@@ -0,0 +1,40 @@
+#Code to create data for standard factsheets for places
+
+#Gabe Morrison
+
+#2023-03-15
+
+library(tidyverse)
+library(tidycensus)
+library(here)
+
+if(!file.exists("data/998_all-places.Rda")) {
+
+  place_geoids <- read_csv(here("mobility-metrics", "place-populations.csv")) %>%
+    filter(year == 2020)
+
+  prepped_places <- place_geoids %>%  
+    mutate(GEOID = paste0(state, place)) %>%
+    select(geoid = GEOID) %>%
+    mutate(state_title = list(state_title = FALSE),
+           geoid = str_c(geoid, ";"),
+           geoid = strsplit(geoid, ";")
+    )
+
+  geoid_lst <- as.list(prepped_places$geoid)
+
+  prepped_places <- tibble(filename = "index.html", 
+                             params = map(geoid_lst, 
+                                          ~list(state_place = ., 
+                                                state_title = FALSE)
+                                          ),
+                             dir_name = str_c("factsheets/998_place-pages/", geoid_lst, "/")
+  )
+
+  save(prepped_places, file = "data/998_all-places.Rda")
+
+} else {
+
+  load("data/998_all-places.Rda")
+
+}

R/create_tb.R

@@ -1,9 +1,9 @@
 #' Create "Summary Table" for a given metric
 #' 
-#'@param metrics_info_df (list) A list composed of 13 elements with information
+#'@param metrics_info (list) A list composed of 13 elements with information
 #'  about a metric. In practice, the first output from the get_vars_info function
 #'  for this argument
-#'@param dataset (data.frame) A dataframe. In practice either the data or data_sub
+#'@param data (data.frame) A dataframe. In practice either the data or data_sub
 #'  objects
 #'@param varname_maps (list of vectors containing strings) A list containing
 #'  four vectors. 
@@ -19,76 +19,57 @@
 #'  Default to 80.
 #'@param tb_align (string) Table alignment. Default set to "left".
 #'@return (gt table object) Returns an unnamed gt table object. 
- 
-create_tb <- function(metrics_info_df, 
-                      dataset, 
+#'
+create_tb <- function(data,
+                      metrics_info, 
                       varname_maps,
                       tb_title_size = 18,
                       tb_subtitle_size = 16,
                       tb_font_size = 14, 
                       source_note_size = 11,
                       tb_width_perc = 80,
                       tb_align = "left"
-                      ){
-
-  mb_metrics <- metrics_info_df$metric_name
-  mb_vars  <- metrics_info_df$metric_vars_prefix[[1]]
-  quality_var  <- metrics_info_df$quality_variable[[1]]
-  metrics_desp  <- metrics_info_df$metrics_description
-  data_source <- metrics_info_df$source_data
-  subgroup_this_var <- metrics_info_df$subgroup_id
-  col_from <- varname_maps[1][[1]]
-  col_to <- varname_maps[2][[1]]
-
-  if (str_detect(subgroup_this_var, fixed("|")) == TRUE) {
-
-    subgroup_this_var <- strsplit(subgroup_this_var, "|", fixed=TRUE)[[1]][1]
-
-  } 
-
-
-  temp <- dataset %>% 
-    filter(subgroup_type == "all", subgroup_id == subgroup_this_var)
-
-
-  temp <- temp %>% 
-    select(matches(glue("{mb_vars}|{quality_var}|state_county"))) %>% 
+                      ) {
+
+  temp <- data %>% 
+    select(
+      matches(metrics_info$metric_vars_prefix),
+      any_of(metrics_info$quality_variable),
+      matches("state_county")
+    ) %>% 
     select(-matches("_lb|_ub")) %>% 
     select(sort(tidyselect::peek_vars())) %>% 
-    rename_at(vars(all_of(col_from)), function(x) col_to) 
+    rename(all_of(varname_maps$summary_vars)) 
 
-
-  if (str_detect(quality_var, "|") == FALSE){ #each variable has its own quality variable  
+  # each variable has its own quality variable
+  if (!str_detect(metrics_info$quality_variable[[1]], "|")) {   
 
     temp <- temp %>% 
-      relocate(!!sym(quality_var), .after = last_col())  
+      relocate(!!sym(metrics_info$quality_variable[[1]]), .after = last_col())  
 
   } 
 
-
+  # transpose table and generate HTML for table
   temp %>% 
+    mutate(across(everything(), as.character)) %>%
     pivot_longer(!state_county, names_to="metrics", values_to="value") %>%   
     pivot_wider(names_from = "state_county", values_from = "value") %>% 
-    arrange(match(metrics, col_to)) %>% 
-    mutate(metrics = gsub(".*_quality", "Quality", metrics)) %>% 
+    arrange(match(metrics, names(varname_maps$detail_vars))) %>% 
+    mutate(metrics = gsub(".*_quality", "Data quality", metrics)) %>% 
     select(metrics, everything()) %>% 
     gt(
       rowname_col = "metrics",
       id = "tb"
     ) %>% 
     tab_header(
       title = "", 
-      subtitle = metrics_desp
+      subtitle = metrics_info$metrics_description
     ) %>% 
-    tab_source_note(html(str_c("<b>Source:</b>", data_source, sep=" "))) %>% 
+    tab_source_note(md(str_c("<b>Source:</b>", metrics_info$source_data, sep=" "))) %>% 
     cols_align(
       align = "left",
       columns = everything()
     ) %>% 
-    # cols_align(
-    #   align = "left",
-    #   columns = TRUE
-    # ) %>% 
     opt_align_table_header("left") %>% 
     tab_options(
       heading.title.font.size = tb_title_size, 
@@ -105,7 +86,8 @@ create_tb <- function(metrics_info_df,
       ),
       locations = cells_body(
         columns = everything(), 
-        rows = metrics == "Quality")
+        rows = metrics == "Data quality")
     ) %>%
     as_raw_html()
+
 }

R/create_tb_detail.R

@@ -0,0 +1,166 @@
+#' Function to create the "Detail" table for a metric
+#' 
+#'@param metrics_info (list) A list composed of 13 elements with information
+#'  about a metric. In practice, the first output from the get_vars_info function
+#'  for this argument
+#'@param data (data.frame) A dataframe. In practice either the data or data_sub
+#'  objects
+#'@param varname_maps (list of vectors containing strings) A list containing
+#'  four vectors. 
+#'    The first vector lists the metric name(s). 
+#'    The second contains "human-readible" names. 
+#'    The third lists the metric names and their relevant confidence interval columns. 
+#'    The four lists the metric name(s) followed by the metric name(s) concatenated with "_ci"
+#'@param tb_title_size (integer) Table title size. Default set to 18
+#'@param tb_subtitle_size (integer) Table sub-title size. Default set to 14.
+#'@param tb_font_size (integer) Table font size. Default set to 12.
+#'@param source_note_size (integer) Size of source note. Default set to 11.
+#'@param tb_width_perc (float) Table width percentage. Should be between 0 and 100.
+#'  Default to 80.
+#'@param tb_align (string) Table alignment. Default set to "left". 
+#'@return (gt table object) Returns an unnamed gt table object.
+
+create_tb_detail <- function(data, 
+                             metrics_info, 
+                             varname_maps,
+                             tb_title_size = 18,
+                             tb_subtitle_size = 16,
+                             tb_font_size = 14, 
+                             source_note_size = 11,
+                             tb_width_perc = 80,
+                             tb_align = "left") {
+
+  mb_vars  <- metrics_info$metric_vars_prefix
+  metrics_desp  <- metrics_info$metrics_description
+  data_source <- metrics_info$source_data
+  subgroup_this_var <- metrics_info$subgroup_id
+  notes <- metrics_info$notes
+
+  if (metrics_info$ci_var == 1) {
+
+    # get variable names for confidence intervals
+    mb_vars_lst <- data %>% 
+      select(matches(mb_vars)) %>%
+      select(matches("_lb|_ub|_quality")) %>%
+      colnames() %>%
+      str_remove_all("_lb|_ub|_quality") %>%
+      unique()
+
+    for (val in mb_vars_lst) {      # update this to purrr 
+
+      # combine two CI variables into one variable
+      data <- unite_col_values(data, val)
+      ci_str <- "Confidence Interval"
+
+    } 
+
+    temp <- data %>% 
+      select(
+        matches(metrics_info$metric_vars_prefix),
+        any_of(metrics_info$quality_variable),
+        matches("state_county"), 
+        -matches("_lb|ub")
+      )
+
+    temp <- temp %>% 
+      mutate_all(as.character) %>% 
+      rename(all_of(varname_maps$detail_vars))
+
+  } else if (metrics_info$ci_var == 2) {
+
+    ci_str <- "Confidence Interval*"   # *CI not available at this time.
+    metrics_desp <- md(glue("{metrics_desp}<sup>*</sup>"))
+
+    temp <- data %>% 
+      select(
+        matches(metrics_info$metric_vars_prefix),
+        any_of(metrics_info$quality_variable),
+        matches("state_county"), 
+        -matches("_lb|ub")
+      )
+
+    notes <- paste0(notes, 
+                    "<br><br>",
+                    "The Confidence Interval for this metric is not available at this time.")
+
+    temp <- temp %>% 
+      mutate_all(as.character) %>% 
+      rename(all_of(varname_maps$summary_vars))
+
+  } else if (metrics_info$ci_var == 3) {
+
+    ci_str <- "Confidence Interval+"   # "+CI not applicable.
+
+    metrics_desp <- md(glue("{metrics_desp}<sup>+</sup>"))
+
+    temp <- data %>% 
+      select(
+        matches(metrics_info$metric_vars_prefix),
+        any_of(metrics_info$quality_variable),
+        matches("state_county"), 
+        -matches("_lb|ub")
+      )
+
+    notes <- paste0(notes, 
+                "<br><br>",
+                "The Confidence Interval for this metric is not applicable.")
+
+    temp <- temp %>% 
+      mutate_all(as.character) %>% 
+      rename(all_of(varname_maps$summary_vars))
+
+  }
+
+
+
+  # each variable has its own quality variable 
+  if (length(metrics_info$quality_variable) > 1){  
+
+    temp <- temp %>% 
+      select(everything(), any_of(metrics_info$quality_variable))  
+
+  } 
+
+  # transpose table and generate HTML for table
+  temp %>% 
+    pivot_longer(!state_county, names_to="metrics", values_to="value") %>%
+    pivot_wider(names_from = "state_county", values_from = "value") %>% 
+    arrange(match(metrics, names(varname_maps$detail_vars))) %>%  
+    mutate(metrics = gsub(".*_ci", ci_str, metrics)) %>% 
+    mutate(metrics = gsub(".*_quality", "Data quality", metrics)) %>% 
+    select(metrics, everything()) %>% 
+    gt(
+      rowname_col = "metrics",
+      id = "tb_level2"
+    ) %>% 
+    tab_header(
+      title = "",
+      subtitle = metrics_desp
+    ) %>%
+    tab_source_note(md(str_c("<b>Source:</b>", data_source, sep=" "))) %>%
+    tab_source_note(md(str_c("<b>Notes:</b>", notes, sep=" "))) %>%
+    cols_align(
+      align = "left",
+      columns = everything()
+    ) %>%
+    opt_align_table_header("left") %>%
+    tab_options(
+      heading.title.font.size = tb_title_size,
+      heading.subtitle.font.size = tb_subtitle_size,
+      column_labels.font.size = tb_font_size,
+      table.font.size = tb_font_size,
+      source_notes.font.size = source_note_size,
+      table.width = pct(tb_width_perc),
+      table.align = tb_align) %>%
+    tab_style(
+      style = list(
+        cell_text(style = "italic"),
+        cell_fill(color = "#ececec")
+      ),
+      locations = cells_body(
+        columns = everything(),
+        rows = metrics == "Data quality")
+    ) %>%
+    as_raw_html()
+
+}