Merge pull request #216 from UI-Research/iss214

Iss214

R/config.R

@@ -10,3 +10,12 @@ 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_tb.R

@@ -55,7 +55,7 @@ create_tb <- function(data,
     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(".*_quality", "Quality", metrics)) %>% 
+    mutate(metrics = gsub(".*_quality", "Data quality", metrics)) %>% 
     select(metrics, everything()) %>% 
     gt(
       rowname_col = "metrics",
@@ -86,7 +86,7 @@ create_tb <- function(data,
       ),
       locations = cells_body(
         columns = everything(), 
-        rows = metrics == "Quality")
+        rows = metrics == "Data quality")
     ) %>%
     as_raw_html()
 

R/create_tb_detail.R

@@ -127,7 +127,7 @@ create_tb_detail <- function(data,
     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", "Quality", metrics)) %>% 
+    mutate(metrics = gsub(".*_quality", "Data quality", metrics)) %>% 
     select(metrics, everything()) %>% 
     gt(
       rowname_col = "metrics",
@@ -159,7 +159,7 @@ create_tb_detail <- function(data,
       ),
       locations = cells_body(
         columns = everything(),
-        rows = metrics == "Quality")
+        rows = metrics == "Data quality")
     ) %>%
     as_raw_html()
 

R/create_tb_more_data.R

@@ -123,16 +123,15 @@ create_tb_more_data <- function(
       names_from = "state_county", 
       values_from = "value"
     ) %>% 
-    mutate(metrics = factor(metrics, levels = c(names(varname_maps$detail_vars), "Quality"))) #%>%
-    #mutate(metrics = gsub(".*_quality", "Quality", metrics))
+    mutate(metrics = factor(metrics, levels = c(names(varname_maps$detail_vars), "Data quality")))
 
   arrange_vars <- c(names(temp)[names(temp) %in% c("subgroup")], "metrics")
 
   temp <- temp %>%
     arrange(desc(year), across(any_of(arrange_vars))) %>% 
     select(metrics, everything()) 
 
-  levels(temp$metrics) <- gsub(".*_quality", "Quality", levels(temp$metrics))
+  levels(temp$metrics) <- gsub(".*_quality", "Data quality", levels(temp$metrics))
   levels(temp$metrics) <- gsub(".*_ci", ci_str, levels(temp$metrics)) 
 
   name_table <- c(
@@ -174,7 +173,7 @@ create_tb_more_data <- function(
       ),
       locations = cells_body(
         columns = everything(), 
-        rows = metrics == "Quality")
+        rows = metrics == "Data quality")
     ) %>%
     as_raw_html()
 

R/prep_pages.R

@@ -20,13 +20,15 @@ library(glue)
 #' @param state_title (boolean) Default to FALSE. The function returns a dataframe
 #'    with one column being a nested list (see below). One component of the list
 #'    is an element named "state_title." This argument is written into that element
+#'  @param geography "county" or "place"
 #' @returns run (tibble) A dataframe with three columns: 
 #'  filename - set to be "index.html" 
 #'  params - contains a list of the fips code listed in the fips and comparisons 
 #'    columns of the datasets pointed to by the url argument
 #'  dirname - location of where knitted hmtl files should be saved
 #'  
-prep_pages <- function(url, output_directory, state_title = FALSE, bespoke = TRUE) {
+prep_pages <- function(url, output_directory, state_title = FALSE, 
+                       fake_labels = FALSE, bespoke = TRUE, geography = "county") {
 
   # read in the applicant list 
   app_list <- read_csv(url)
@@ -53,24 +55,48 @@ prep_pages <- function(url, output_directory, state_title = FALSE, bespoke = TRU
     app_list$uni_id
     )
 
-  if ("random_id" %in% names(app_list)) {
-    # create a data frame with parameters and output file names
-    runs <- tibble(
-      filename = "index.html",             # creates a string with output file names in the form <index>.pdf
-      params = map(app_indexes, ~list(state_county = ., state_title = state_title)), 
-      dir_name = paste0(output_directory, '/', full_name_lst, "_", app_list$random_id)
-    )        # creates a nest list of parameters for each object in the index
+  if (geography == "county") {
 
-  } else {
-    # create a data frame with parameters and output file names
-    runs <- tibble(
-      filename = "index.html",             # creates a string with output file names in the form <index>.pdf
-      params = map(app_indexes, ~list(state_county = ., state_title = state_title)), 
-      dir_name = map(full_name_lst, function(x) paste0(output_directory, glue('/{x}')))
-    )        # creates a nest list of parameters for each object in the index
+    if ("random_id" %in% names(app_list)) {
+      # create a data frame with parameters and output file names
+      runs <- tibble(
+        filename = "index.html",             # creates a string with output file names in the form <index>.pdf
+        params = map(app_indexes, ~list(state_county = ., state_title = state_title, fake_labels = fake_labels)), 
+        dir_name = paste0(output_directory, '/', full_name_lst, "_", app_list$random_id, "/")
+      )        # creates a nest list of parameters for each object in the index
+
+    } else {
+      # create a data frame with parameters and output file names
+      runs <- tibble(
+        filename = "index.html",             # creates a string with output file names in the form <index>.pdf
+        params = map(app_indexes, ~list(state_county = ., state_title = state_title, fake_labels = fake_labels)), 
+        dir_name = map(full_name_lst, function(x) paste0(output_directory, glue('/{x}/')))
+      )        # creates a nest list of parameters for each object in the index
+
+    }
+
+  } else if (geography == "place") {
+
+    if ("random_id" %in% names(app_list)) {
+      # create a data frame with parameters and output file names
+      runs <- tibble(
+        filename = "index.html",             # creates a string with output file names in the form <index>.pdf
+        params = map(app_indexes, ~list(state_place = ., state_title = state_title, fake_labels = fake_labels)), 
+        dir_name = paste0(output_directory, '/', full_name_lst, "_", app_list$random_id, "/")
+      )        # creates a nest list of parameters for each object in the index
+
+    } else {
+      # create a data frame with parameters and output file names
+      runs <- tibble(
+        filename = "index.html",             # creates a string with output file names in the form <index>.pdf
+        params = map(app_indexes, ~list(state_place = ., state_title = state_title, fake_labels = fake_labels)), 
+        dir_name = map(full_name_lst, function(x) paste0(output_directory, glue('/{x}/')))
+      )        # creates a nest list of parameters for each object in the index
+
+    }
 
   }
-
+    
   return(runs)
 
 }

R/quarto_render_wrapper.R

@@ -15,88 +15,73 @@
 #'  output_file path 
 
 quarto_render_wrapper <- function(input, output_file, execute_params, dir_name) {
-
-  # delete directory and contents if it exists
+  
+  # delete the directory if it exists
   if (dir.exists(dir_name)) {
 
     unlink(dir_name, recursive = TRUE)
 
   }
 
-  # create directory
+  # create destination directory for data tables
   if (!dir.exists(dir_name)){
 
     dir.create(dir_name)
 
   }
 
-  # copy index.qmd
-  template_name <- paste0(dir_name, "index.qmd")
-  if (!file.exists(template_name)) {
-
-    file.copy(
-      from = input, 
-      to = template_name
-    )
-
-  }
-
-  # copy project yaml
-  yaml_name <- paste0(dir_name, "_quarto.yml")
-  if (!file.exists(yaml_name)) {
-
-    file.copy(
-      from = "_quarto.yml", 
-      to = yaml_name
-    )
-
-  }
-
-  # copy description .qmd
-  description_qmd_name <- paste0(dir_name, "description.qmd")
-  if (!file.exists(description_qmd_name)) {
-
-    file.copy(
-      from = "description.qmd", 
-      to = description_qmd_name
-    )
-
-  }
+  # copy supporting files to destination directory
+  www_name <- paste0(dir_name, "www")
+  dir.create(www_name)
+  file.copy(
+    from = "www", 
+    to = dir_name,
+    recursive = TRUE
+  )
 
-  # copy description html
+  # copy description html to destination directory
   description_html_name <- paste0(dir_name, "description.html")
-  if (!file.exists(description_html_name)) {
-
-    file.copy(
-      from = "description.html",
-      to = description_html_name
-    )
-
-  }
+  file.copy(
+    from = "description.html",
+    to = description_html_name,
+    overwrite = TRUE
+  )
 
-  www_name <- paste0(dir_name, "www")
-  if (!file.exists(www_name)) {
-
-    dir.create(www_name)
-
-    file.copy(
-      from = "www", 
-      to = dir_name,
-      recursive = TRUE
-    )
-
-  }
+  # copy input to generic index.qmd
+  # this is needed so _quarto.yml will work with the county and city templates
+  file.copy(
+    from = input, 
+    to = paste0(dir_name, "index.qmd")
+  )
 
+  # this file ensures that the rendered document is a full website instead of 
+  # individual pages
+  file.copy(
+    from = "_quarto.yml", 
+    to = paste0(dir_name, "_quarto.yml")
+  )
 
-  quarto_render(
-    input = template_name,
-    output_file = output_file,
-    execute_params = execute_params
+  # copy analytics header
+  file.copy(
+    from = "analytics.html", 
+    to = paste0(dir_name, "analytics.html")
+  )
+
+  # render the quarto document in the new directory
+  # rendering in the top level directory and then copying does not work
+  xfun::in_dir(
+    dir = dir_name,
+    expr = quarto_render(
+      input = "index.qmd",
+      output_file = basename(output_file),
+      execute_params = execute_params
+    )
   )
 
-  file.remove(template_name)
-  file.remove(description_qmd_name)
-  file.remove(yaml_name)
+  # delete extra files
+  file.remove(paste0(dir_name, "search.json"))
+  file.remove(paste0(dir_name, "index.qmd"))
+  file.remove(paste0(dir_name, "analytics.html"))
 
 }
 

R/startup.R

@@ -0,0 +1,19 @@
+#Startup script for Ec2 instances:
+install.packages("quarto")
+install.packages("tidycensus")
+install.packages("tictoc")
+install.packages("sf")
+install.packages("gtable")
+install.packages("here")
+install.packages("future")
+install.packages("furrr")
+install.packages("gt")
+install.packages("qdapRegex")
+
+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")
+}

create_bespoke_pages.R

@@ -144,4 +144,17 @@ prepped24 <- prep_pages(url = "data/24_website_requests.csv",
 
 render_pages(prepped_object = prepped24)
 
+# Upward County, MB
+prepped25 <- prep_pages(url = "data/25_upward-county.csv",
+                        output_directory = "factsheets/25_upward-county", 
+                        fake_labels = "yes")
 
+render_pages(prepped_object = prepped25, input = "index-county.qmd")
+
+# Upward City, MB
+prepped26 <- prep_pages(url = "data/26_upward-city.csv",
+                        output_directory = "factsheets/26_upward-city",
+                        fake_labels = "yes",
+                        geography = "place")
+
+render_pages(prepped_object = prepped26, input = "index-place.qmd")

create_standard_pages.R

@@ -7,6 +7,7 @@
 library(tidyverse)
 library(quarto)
 library(tidycensus)
+library(furrr)
 
 source("R/create_standard_county_df.R")
 source("R/create_standard_place_df.R")