Merge pull request #1541 from cmu-delphi/ndefries/wave12-new-indicators

[CTIS] New child schooling and child age indicators for Wave 12

Author: krivard

facebook/delphiFacebook/R/binary.R

@@ -131,7 +131,13 @@ get_binary_indicators <- function() {
     "smoothed_wvaccinate_children", "weight", "v_vaccinate_children", 6, compute_binary_response, jeffreys_binary,
     "smoothed_vaccinate_child_oldest", "weight_unif", "v_vaccinate_child_oldest", 6, compute_binary_response, jeffreys_binary,
     "smoothed_wvaccinate_child_oldest", "weight", "v_vaccinate_child_oldest", 6, compute_binary_response, jeffreys_binary,
-    
+
+    "smoothed_wchild_vaccine_already", "weight", "v_child_vaccine_already", 6, compute_binary_response, jeffreys_multinomial_factory(5),
+    "smoothed_wchild_vaccine_yes_def", "weight", "v_child_vaccine_yes_def", 6, compute_binary_response, jeffreys_multinomial_factory(5),
+    "smoothed_wchild_vaccine_yes_prob", "weight", "v_child_vaccine_yes_prob", 6, compute_binary_response, jeffreys_multinomial_factory(5),
+    "smoothed_wchild_vaccine_no_prob", "weight", "v_child_vaccine_no_prob", 6, compute_binary_response, jeffreys_multinomial_factory(5),
+    "smoothed_wchild_vaccine_no_def", "weight", "v_child_vaccine_no_def", 6, compute_binary_response, jeffreys_multinomial_factory(5),
+
     "smoothed_try_vaccinate_1m", "weight_unif", "v_try_vaccinate_1m", 6, compute_binary_response, jeffreys_binary,
     "smoothed_wtry_vaccinate_1m", "weight", "v_try_vaccinate_1m", 6, compute_binary_response, jeffreys_binary,
 
@@ -332,11 +338,26 @@ get_binary_indicators <- function() {
     "smoothed_inperson_school_parttime", "weight_unif", "s_inperson_school_parttime", 6, compute_binary_response, jeffreys_binary,
     "smoothed_winperson_school_parttime", "weight", "s_inperson_school_parttime", 6, compute_binary_response, jeffreys_binary,
 
-    "smoothed_inperson_school_fulltime_oldest", "weight_unif", "s_inperson_school_fulltime_oldest", 6, compute_binary_response, jeffreys_binary,
-    "smoothed_winperson_school_fulltime_oldest", "weight", "s_inperson_school_fulltime_oldest", 6, compute_binary_response, jeffreys_binary,
-    "smoothed_inperson_school_parttime_oldest", "weight_unif", "s_inperson_school_parttime_oldest", 6, compute_binary_response, jeffreys_binary,
-    "smoothed_winperson_school_parttime_oldest", "weight", "s_inperson_school_parttime_oldest", 6, compute_binary_response, jeffreys_binary,
-    
+    "smoothed_inperson_school_fulltime_oldest", "weight_unif", "s_inperson_school_fulltime_oldest", 6, compute_binary_response, jeffreys_multinomial_factory(3),
+    "smoothed_winperson_school_fulltime_oldest", "weight", "s_inperson_school_fulltime_oldest", 6, compute_binary_response, jeffreys_multinomial_factory(3),
+    "smoothed_inperson_school_parttime_oldest", "weight_unif", "s_inperson_school_parttime_oldest", 6, compute_binary_response, jeffreys_multinomial_factory(3),
+    "smoothed_winperson_school_parttime_oldest", "weight", "s_inperson_school_parttime_oldest", 6, compute_binary_response, jeffreys_multinomial_factory(3),
+    "smoothed_wremote_school_fulltime_oldest", "weight", "s_remote_school_fulltime_oldest", 6, compute_binary_response, jeffreys_multinomial_factory(3),
+
+    "smoothed_wschool_safety_measures_mask_students", "weight", "s_school_safety_measures_mask_students", 6, compute_binary_response, jeffreys_binary,
+    "smoothed_wschool_safety_measures_mask_teachers", "weight", "s_school_safety_measures_mask_teachers", 6, compute_binary_response, jeffreys_binary,
+    "smoothed_wschool_safety_measures_restricted_entry", "weight", "s_school_safety_measures_restricted_entry", 6, compute_binary_response, jeffreys_binary,
+    "smoothed_wschool_safety_measures_separators", "weight", "s_school_safety_measures_separators", 6, compute_binary_response, jeffreys_binary,
+    "smoothed_wschool_safety_measures_extracurricular", "weight", "s_school_safety_measures_extracurricular", 6, compute_binary_response, jeffreys_binary,
+    "smoothed_wschool_safety_measures_symptom_screen", "weight", "s_school_safety_measures_symptom_screen", 6, compute_binary_response, jeffreys_binary,
+    "smoothed_wschool_safety_measures_ventilation", "weight", "s_school_safety_measures_ventilation", 6, compute_binary_response, jeffreys_binary,
+    "smoothed_wschool_safety_measures_testing_staff", "weight", "s_school_safety_measures_testing_staff", 6, compute_binary_response, jeffreys_binary,
+    "smoothed_wschool_safety_measures_testing_students", "weight", "s_school_safety_measures_testing_students", 6, compute_binary_response, jeffreys_binary,
+    "smoothed_wschool_safety_measures_vaccine_staff", "weight", "s_school_safety_measures_vaccine_staff", 6, compute_binary_response, jeffreys_binary,
+    "smoothed_wschool_safety_measures_vaccine_students", "weight", "s_school_safety_measures_vaccine_students", 6, compute_binary_response, jeffreys_binary,
+    "smoothed_wschool_safety_measures_cafeteria", "weight", "s_school_safety_measures_cafeteria", 6, compute_binary_response, jeffreys_binary,
+    "smoothed_wschool_safety_measures_dont_know", "weight", "s_school_safety_measures_dont_know", 6, compute_binary_response, jeffreys_binary,
+
     # beliefs
     "smoothed_belief_masking_effective", "weight_unif", "b_belief_masking_effective", 6, compute_binary_response, jeffreys_binary,
     "smoothed_wbelief_masking_effective", "weight", "b_belief_masking_effective", 6, compute_binary_response, jeffreys_binary,
@@ -396,9 +417,7 @@ get_binary_indicators <- function() {
     "smoothed_want_info_employment", "weight_unif", "i_want_info_employment", 6, compute_binary_response, jeffreys_binary,
     "smoothed_wwant_info_employment", "weight", "i_want_info_employment", 6, compute_binary_response, jeffreys_binary,
     "smoothed_want_info_none", "weight_unif", "i_want_info_none", 6, compute_binary_response, jeffreys_binary,
-    "smoothed_wwant_info_none", "weight", "i_want_info_none", 6, compute_binary_response, jeffreys_binary,
-   
-    
+    "smoothed_wwant_info_none", "weight", "i_want_info_none", 6, compute_binary_response, jeffreys_binary
   )
 
 

facebook/delphiFacebook/R/contingency_indicators.R

@@ -141,6 +141,12 @@ get_aggs <- function() {
     "pct_vaccinate_children", "v_vaccinate_children", compute_binary, jeffreys_binary,
     "pct_vaccinate_child_oldest", "v_vaccinate_child_oldest", compute_binary, jeffreys_binary,
 
+    "pct_child_vaccine_already", "v_child_vaccine_already", compute_binary, jeffreys_multinomial_factory(5),
+    "pct_child_vaccine_yes_def", "v_child_vaccine_yes_def", compute_binary, jeffreys_multinomial_factory(5),
+    "pct_child_vaccine_yes_prob", "v_child_vaccine_yes_prob", compute_binary, jeffreys_multinomial_factory(5),
+    "pct_child_vaccine_no_prob", "v_child_vaccine_no_prob", compute_binary, jeffreys_multinomial_factory(5),
+    "pct_child_vaccine_no_def", "v_child_vaccine_no_def", compute_binary, jeffreys_multinomial_factory(5),
+
     "pct_accept_vaccine_defyes", "v_accept_vaccine_defyes", compute_binary, jeffreys_multinomial_factory(4),
     "pct_accept_vaccine_probyes", "v_accept_vaccine_probyes", compute_binary, jeffreys_multinomial_factory(4),
     "pct_accept_vaccine_probno", "v_accept_vaccine_probno", compute_binary, jeffreys_multinomial_factory(4),
@@ -448,11 +454,39 @@ get_aggs <- function() {
 
     # schooling
     "pct_inperson_school_fulltime", "s_inperson_school_fulltime", compute_binary, jeffreys_binary,
-    "pct_inperson_school_parttime", "s_inperson_school_parttime", compute_binary, jeffreys_binary
+    "pct_inperson_school_parttime", "s_inperson_school_parttime", compute_binary, jeffreys_binary,
+
+    "pct_remote_school_fulltime_oldest", "s_remote_school_fulltime_oldest", compute_binary, jeffreys_multinomial_factory(3),
+    "pct_inperson_school_fulltime_oldest", "s_inperson_school_fulltime_oldest", compute_binary, jeffreys_multinomial_factory(3),
+    "pct_inperson_school_parttime_oldest", "s_inperson_school_parttime_oldest", compute_binary, jeffreys_multinomial_factory(3),
+
+    "pct_school_safety_measures_mask_students", "s_school_safety_measures_mask_students", compute_binary, jeffreys_binary,
+    "pct_school_safety_measures_mask_teachers", "s_school_safety_measures_mask_teachers", compute_binary, jeffreys_binary,
+    "pct_school_safety_measures_restricted_entry", "s_school_safety_measures_restricted_entry", compute_binary, jeffreys_binary,
+    "pct_school_safety_measures_separators", "s_school_safety_measures_separators", compute_binary, jeffreys_binary,
+    "pct_school_safety_measures_extracurricular", "s_school_safety_measures_extracurricular", compute_binary, jeffreys_binary,
+    "pct_school_safety_measures_symptom_screen", "s_school_safety_measures_symptom_screen", compute_binary, jeffreys_binary,
+    "pct_school_safety_measures_ventilation", "s_school_safety_measures_ventilation", compute_binary, jeffreys_binary,
+    "pct_school_safety_measures_testing_staff", "s_school_safety_measures_testing_staff", compute_binary, jeffreys_binary,
+    "pct_school_safety_measures_testing_students", "s_school_safety_measures_testing_students", compute_binary, jeffreys_binary,
+    "pct_school_safety_measures_vaccine_staff", "s_school_safety_measures_vaccine_staff", compute_binary, jeffreys_binary,
+    "pct_school_safety_measures_vaccine_students", "s_school_safety_measures_vaccine_students", compute_binary, jeffreys_binary,
+    "pct_school_safety_measures_cafeteria", "s_school_safety_measures_cafeteria", compute_binary, jeffreys_binary,
+    "pct_school_safety_measures_dont_know", "s_school_safety_measures_dont_know", compute_binary, jeffreys_binary
   )
 
   aggs <- create_aggs_product(regions, groups, indicators)
-  
+
+
+  monthly_indicators <- tribble(
+    ~name, ~metric, ~compute_fn, ~post_fn,
+    "pct_child_school_public", "s_child_school_public", compute_binary, jeffreys_multinomial_factory(5),
+    "pct_child_school_private", "s_child_school_private", compute_binary, jeffreys_multinomial_factory(5),
+    "pct_child_school_homeschool", "s_child_school_homeschool", compute_binary, jeffreys_multinomial_factory(5),
+    "pct_child_school_not", "s_child_school_not", compute_binary, jeffreys_multinomial_factory(5),
+    "pct_child_school_other", "s_child_school_other", compute_binary, jeffreys_multinomial_factory(5)
+  )
+  monthly_aggs <- create_aggs_product(regions, groups, monthly_indicators)
 
   ### Include handful of original public tables not already covered by set above
   common_group <- c("agefull", "gender", "race", "hispanic")
@@ -509,7 +543,7 @@ get_aggs <- function() {
   aggs <- rbind(aggs, cut1_aggs, cut2_aggs, cut3_aggs, cut456_aggs, cut456_marginal_aggs)
 
   weekly_aggs <- aggs
-  monthly_aggs <- aggs
+  monthly_aggs <- rbind(aggs, monthly_aggs)
 
   return(list("week"=weekly_aggs, "month"=monthly_aggs))
 }

facebook/delphiFacebook/R/responses.R

@@ -193,6 +193,7 @@ load_response_one <- function(input_filename, params, contingency_run) {
   input_data <- code_activities(input_data, wave)
   input_data <- code_vaccines(input_data, wave)
   input_data <- code_schooling(input_data, wave)
+  input_data <- code_children(input_data, wave)
   input_data <- code_beliefs(input_data, wave)
   input_data <- code_news_and_info(input_data, wave)
   input_data <- code_gender(input_data, wave)

facebook/delphiFacebook/R/variables.R

@@ -833,8 +833,20 @@ code_vaccines <- function(input_data, wave) {
       input_data$P3 == 5 ~ 1,
       TRUE ~ NA_real_
     )
+
+    input_data$v_child_vaccine_already <- input_data$P3 == 5
+    input_data$v_child_vaccine_yes_def <- input_data$P3 == 1
+    input_data$v_child_vaccine_yes_prob <- input_data$P3 == 2
+    input_data$v_child_vaccine_no_prob <- input_data$P3 == 3
+    input_data$v_child_vaccine_no_def <- input_data$P3 == 4
+
   } else {
     input_data$v_vaccinate_child_oldest <- NA_real_
+    input_data$v_child_vaccine_already <- NA
+    input_data$v_child_vaccine_yes_def <- NA
+    input_data$v_child_vaccine_yes_prob <- NA
+    input_data$v_child_vaccine_no_prob <- NA
+    input_data$v_child_vaccine_no_def <- NA
   }
 
   if ( "V16" %in% names(input_data) ) {
@@ -906,6 +918,34 @@ code_vaccines <- function(input_data, wave) {
   return(input_data)
 }
 
+#' Misc children
+#'
+#' @param input_data input data frame of raw survey data
+#' @param wave integer indicating survey version
+#'
+#' @return augmented data frame
+code_children <- function(input_data, wave) {
+  if ("P2" %in% names(input_data)) {
+    input_data$ch_has_child_under_18 <- input_data$P1 == 1
+  } else {
+    input_data$ch_has_child_under_18 <- NA
+  }
+
+  if ("P2" %in% names(input_data)) {
+    input_data$ch_oldest_child_under_5 <- input_data$P2 == 1
+    input_data$ch_oldest_child_5_to_11 <- input_data$P2 == 2
+    input_data$ch_oldest_child_12_to_15 <- input_data$P2 == 3
+    input_data$ch_oldest_child_16_to_17 <- input_data$P2 == 4
+  } else {
+    input_data$ch_oldest_child_under_5 <- NA
+    input_data$ch_oldest_child_5_to_11 <- NA
+    input_data$ch_oldest_child_12_to_15 <- NA
+    input_data$ch_oldest_child_16_to_17 <- NA
+  }
+
+  return(input_data)
+}
+
 #' Schooling
 #'
 #' @param input_data input data frame of raw survey data
@@ -948,11 +988,65 @@ code_schooling <- function(input_data, wave) {
       input_data$P5 != 3 ~ 0,
       TRUE ~ NA_real_
     )
+    input_data$s_remote_school_fulltime_oldest <- case_when(
+      input_data$P5 == 2 ~ 1,
+      input_data$P5 != 2 ~ 0,
+      TRUE ~ NA_real_
+    )
 
   } else {
     input_data$s_inperson_school_fulltime_oldest <- NA_real_
     input_data$s_inperson_school_parttime_oldest <- NA_real_
+    input_data$s_remote_school_fulltime_oldest <- NA_real_
+  }
+
+  if ("P4" %in% names(input_data)) {
+    input_data$s_child_school_public <- input_data$P4 == 1
+    input_data$s_child_school_private <- input_data$P4 == 2
+    input_data$s_child_school_homeschool <- input_data$P4 == 3
+    input_data$s_child_school_not <- input_data$P4 == 4
+    input_data$s_child_school_other <- input_data$P4 == 5
+  } else {
+    input_data$s_child_school_public <- NA
+    input_data$s_child_school_private <- NA
+    input_data$s_child_school_homeschool <- NA
+    input_data$s_child_school_not <- NA
+    input_data$s_child_school_other <- NA
   }
+
+
+  if ("P6" %in% names(input_data)) {
+    safety_measures <- split_options(input_data$P6)
+
+    input_data$s_school_safety_measures_mask_students <- is_selected(safety_measures, "1")
+    input_data$s_school_safety_measures_mask_teachers <- is_selected(safety_measures, "2")
+    input_data$s_school_safety_measures_restricted_entry <- is_selected(safety_measures, "6")
+    input_data$s_school_safety_measures_separators <- is_selected(safety_measures, "10")
+    input_data$s_school_safety_measures_extracurricular <- is_selected(safety_measures, "12")
+    input_data$s_school_safety_measures_symptom_screen <- is_selected(safety_measures, "15")
+    input_data$s_school_safety_measures_ventilation <- is_selected(safety_measures, "17")
+    input_data$s_school_safety_measures_testing_staff <- is_selected(safety_measures, "18")
+    input_data$s_school_safety_measures_testing_students <- is_selected(safety_measures, "19")
+    input_data$s_school_safety_measures_vaccine_staff <- is_selected(safety_measures, "20")
+    input_data$s_school_safety_measures_vaccine_students <- is_selected(safety_measures, "21")
+    input_data$s_school_safety_measures_cafeteria <- is_selected(safety_measures, "22")
+    input_data$s_school_safety_measures_dont_know <- is_selected(safety_measures, "16")
+  } else {
+    input_data$s_school_safety_measures_mask_students <- NA
+    input_data$s_school_safety_measures_mask_teachers <- NA
+    input_data$s_school_safety_measures_restricted_entry <- NA
+    input_data$s_school_safety_measures_separators <- NA
+    input_data$s_school_safety_measures_extracurricular <- NA
+    input_data$s_school_safety_measures_symptom_screen <- NA
+    input_data$s_school_safety_measures_ventilation <- NA
+    input_data$s_school_safety_measures_testing_staff <- NA
+    input_data$s_school_safety_measures_testing_students <- NA
+    input_data$s_school_safety_measures_vaccine_staff <- NA
+    input_data$s_school_safety_measures_vaccine_students <- NA
+    input_data$s_school_safety_measures_cafeteria <- NA
+    input_data$s_school_safety_measures_dont_know <- NA
+  }
+
 
   return(input_data)
 }