[CTIS contingency] Make themed and demographic tables

facebook/delphiFacebook/DESCRIPTION

@@ -15,6 +15,8 @@ Imports:
     rlang,
     readr,
     dplyr,
+    plyr,
+    tidyr,
     stringi,
     jsonlite,
     lubridate,
@@ -29,5 +31,5 @@ Suggests:
     testthat (>= 1.0.1),
     covr (>= 2.2.2)
 LinkingTo: Rcpp
-RoxygenNote: 7.1.1
+RoxygenNote: 7.2.0
 Encoding: UTF-8

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)
@@ -98,6 +99,7 @@ importFrom(lubridate,ymd)
 importFrom(lubridate,ymd_hms)
 importFrom(parallel,detectCores)
 importFrom(parallel,mclapply)
+importFrom(plyr,round_any)
 importFrom(purrr,reduce)
 importFrom(readr,col_character)
 importFrom(readr,col_integer)
@@ -115,6 +117,7 @@ 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)
@@ -127,5 +130,6 @@ importFrom(survey,svymean)
 importFrom(survey,svyvar)
 importFrom(tibble,add_column)
 importFrom(tibble,tribble)
+importFrom(tidyr,drop_na)
 importFrom(utils,tail)
 useDynLib(delphiFacebook, .registration = TRUE)

facebook/delphiFacebook/R/contingency_aggregate.R

@@ -26,6 +26,7 @@
 #' @import data.table
 #' @importFrom dplyr full_join %>% select all_of
 #' @importFrom purrr reduce
+#' @importFrom tidyr drop_na
 #'
 #' @export
 produce_aggregates <- function(df, aggregations, cw_list, params) {
@@ -65,6 +66,12 @@ produce_aggregates <- function(df, aggregations, cw_list, params) {
     geo_level <- agg_groups$geo_level[group_ind]
     geo_crosswalk <- cw_list[[geo_level]]
 
+    if (geo_level == "county") {
+      # Raise sample size threshold to 100.
+      old_thresh <- params$num_filter
+      params$num_filter <- 100L
+    }
+
     # Subset aggregations to keep only those grouping by the current agg_group
     # and with the current geo_level. `setequal` ignores differences in
     # ordering and only looks at unique elements.
@@ -95,6 +102,22 @@ produce_aggregates <- function(df, aggregations, cw_list, params) {
     if ( length(dfs_out) != 0 ) {
       df_out <- dfs_out %>% reduce(full_join, by=agg_group, suff=c("", ""))
       write_contingency_tables(df_out, params, geo_level, agg_group)
+
+      for (theme in names(THEME_GROUPS)) {
+        theme_out <- select(df_out, agg_group, contains(THEME_GROUPS[[theme]]))
+        # Drop any rows that are completely `NA`. Grouping variables are always
+        # defined, so need to ignore those.
+        theme_out <- drop_na(theme_out, !!setdiff(names(theme_out), agg_group))
+
+        if ( nrow(theme_out) != 0 && ncol(theme_out) != 0 ) {
+          write_contingency_tables(theme_out, params, geo_level, agg_group, theme)  
+        }
+      }
+    }
+
+    if (geo_level == "county") {
+      # Restore old sample size threshold
+      params$num_filter <- old_thresh
     }
   }
 }
@@ -295,10 +318,14 @@ summarize_aggs <- function(df, crosswalk_data, aggregations, geo_level, params)
       rowSums(is.na(dfs_out[[aggregation]][, c("val", "sample_size")])) == 0,
     ]
 
+    # Censor rows with low sample size
     dfs_out[[aggregation]] <- apply_privacy_censoring(dfs_out[[aggregation]], params)
 
-    ## Apply the post-function
+    # Apply the post-function
     dfs_out[[aggregation]] <- post_fn(dfs_out[[aggregation]])
+
+    # Round sample sizes
+    dfs_out[[aggregation]] <- round_n(dfs_out[[aggregation]], params)
   }
 
   return(dfs_out)