[fb-survey] Use effective samples size for binary SEs

facebook/delphiFacebook/R/aggregate.R

@@ -203,10 +203,9 @@ summarize_indicators_day <- function(day_df, indicators, target_day, geo_level,
 
         sample_size <- sum(ind_df$weight_in_location)
 
-        ## TODO: See issue #764
         new_row <- compute_fn(
           response = ind_df[[metric]],
-          weight = if (indicators$skip_mixing[row]) { mixing$normalized_preweights } else { mixing$weights },
+          weight = mixing$weights,
           sample_size = sample_size)
 
         dfs_out[[indicator]][["val"]][ii] <- new_row$val
@@ -217,15 +216,13 @@ summarize_indicators_day <- function(day_df, indicators, target_day, geo_level,
     }
   }
 
-  # Convert list of lists to list of tibbles.
-  for (indicator in indicators$name) {
-   dfs_out[[indicator]] <- bind_rows(dfs_out[[indicator]])
-  }
-
   for (row in seq_len(nrow(indicators))) {
     indicator <- indicators$name[row]
     post_fn <- indicators$post_fn[[row]]
 
+    # Convert list of lists to list of tibbles.
+    dfs_out[[indicator]] <- bind_rows(dfs_out[[indicator]])
+
     dfs_out[[indicator]] <- dfs_out[[indicator]][
       rowSums(is.na(dfs_out[[indicator]][, c("val", "sample_size", "geo_id", "day")])) == 0,
     ]

facebook/delphiFacebook/R/binary.R

@@ -381,9 +381,6 @@ get_binary_indicators <- function() {
 
   )
 
-
-  ind$skip_mixing <- TRUE
-
   return(ind)
 }
 
@@ -410,10 +407,12 @@ compute_binary_response <- function(response, weight, sample_size)
   response_prop <- weighted.mean(response, weight)
 
   val <- 100 * response_prop
+
+  effective_sample_size <- length(weight) * mean(weight)^2 / mean(weight^2)
 
   return(list(val = val,
               se = NA_real_,
-              effective_sample_size = sample_size)) # TODO effective sample size
+              effective_sample_size = effective_sample_size))
 }
 
 #' Apply a Jeffreys correction to estimates and their standard errors.
@@ -438,8 +437,8 @@ jeffreys_multinomial_factory <- function(k) {
   # Returns: Updated data frame.
   jeffreys_multinomial <- function(df) {
     return(mutate(df,
-                  val = jeffreys_percentage(.data$val, .data$sample_size, k),
-                  se = binary_se(.data$val, .data$sample_size)))
+                  val = jeffreys_percentage(.data$val, .data$effective_sample_size, k),
+                  se = binary_se(.data$val, .data$effective_sample_size)))
   }
 
   return(jeffreys_multinomial)
@@ -467,6 +466,6 @@ jeffreys_percentage <- function(percentage, sample_size, k) {
 #' @return Vector of standard errors; NA when a sample size is 0.
 binary_se <- function(val, sample_size) {
   return(ifelse(sample_size > 0,
-                sqrt( (val * (100 - val) / sample_size) ),
+                sqrt( val * (100 - val) / (sample_size + 1) ),
                 NA))
 }

facebook/delphiFacebook/R/contingency_aggregate.R

@@ -354,10 +354,9 @@ summarize_aggregations_group <- function(group_df, aggregations, target_group, g
       sample_size <- sum(agg_df$weight_in_location)
       total_represented <- sum(agg_df[[var_weight]] * agg_df$weight_in_location)
 
-      ## TODO: See issue #764
       new_row <- compute_fn(
         response = agg_df[[metric]],
-        weight = if (aggregations$skip_mixing[row]) { mixing$normalized_preweights } else { mixing$weights },
+        weight = mixing$weights,
         sample_size = sample_size,
         total_represented = total_represented)
 

facebook/delphiFacebook/R/contingency_utils.R

@@ -209,9 +209,8 @@ verify_aggs <- function(aggregations) {
                            MARGIN=1, FUN=paste, collapse="_")
 
   aggregations$var_weight <- "weight"
-  aggregations$skip_mixing <- FALSE
 
-  expected_names <- c("name", "var_weight", "metric", "group_by", "skip_mixing", 
+  expected_names <- c("name", "var_weight", "metric", "group_by",
                       "compute_fn", "post_fn", "id")
   if ( !all(expected_names %in% names(aggregations)) ) {
     stop(sprintf(

facebook/delphiFacebook/R/count.R

@@ -15,8 +15,6 @@ get_hh_count_indicators <- function() {
     "smoothed_wili", "weight", "hh_p_ili", 6, compute_count_response, jeffreys_count
   )
 
-  ind$skip_mixing <- FALSE
-
   return(ind)
 }
 

facebook/delphiFacebook/integration-tests/testthat/gold_receiving/20200508_county_raw_cli.csv

@@ -1,8 +1,13 @@
 geo_id,val,se,sample_size,effective_sample_size
+01000,0,4.5174514,6,10.0681877
 01097,0,12.5,3,3
+02000,0,16.6666667,2,2
+04000,0,10.85673,3.0005,3.6054383
 04013,0,6.25,7,7
 04019,0,6.2500002,6.9995,6.9999998
+05000,0,6.25,4,7
 05007,0,12.5,3,3
+06000,0,2.5,16.0031,19
 06001,0,12.2581137,3.0021,3.078931
 06013,0,12.5,3,3
 06019,0,12.5000181,2.9969,2.9999942
@@ -16,13 +21,16 @@ geo_id,val,se,sample_size,effective_sample_size
 06085,0,16.6666667,2,2
 06097,0,16.6666667,2,2
 06111,0,12.5,3,3
+08000,0,6.7186362,3.8717,6.4419865
 08035,0,16.6666667,2,2
 08041,0,12.5,3,3
 08069,0,15.110304,2.1283,2.3090003
 08077,0,12.5,3,3
+09000,0,10.0000061,3,3.9999969
 09003,0,16.6666667,2,2
 09011,0,16.6666667,2,2
 10003,0,16.6666667,2,2
+12000,0,1.5229795,23.8825,31.8303826
 12001,0,10.0872768,3.761,3.9567392
 12057,0,12.6848279,2.7155,2.9417169
 12071,0,7.0515061,6.0032,6.0906838
@@ -33,49 +41,70 @@ geo_id,val,se,sample_size,effective_sample_size
 12105,0,12.5,3,3
 12115,0,14.5733531,2.1762,2.4309194
 12127,0,16.6666667,2,2
+13000,0,1.7789135,12.8648,27.1070447
 13121,0,12.5000158,2.9971,2.9999949
 13135,0,14.8694047,2.1503,2.3626094
 13153,0,12.5002821,2.9878,2.9999097
 13215,0,12.5,3,3
+16000,0,5.3897351,5,8.2768937
+17000,0,1.7119806,18.077,28.2059384
 17031,0,3.3259082,13.5695,14.0334875
 17043,0,6.2024286,6.6376,7.0613584
 17089,0,14.0420709,2.2127,2.5607284
 17097,0,10.4309112,3.5032,3.7934451
 17201,0,16.6666667,2,2
+18000,0,6.25,6,7
 18039,0,12.5,3,3
 18097,0,16.6666667,2,2
+19000,0,2.264424,14.9005,21.0806706
 19153,0,16.6666667,2,2
+20000,0,3.1451652,7.9999,14.8974162
+21000,0,4.1455187,8,11.0612167
 21047,0,16.6666667,2,2
 21117,0,16.6666667,2,2
+22000,0,4.5454545,8,10
 22055,0,16.6666667,2,2
 22071,0,16.6666667,2,2
+23000,0,7.0889378,6,6.0532429
+24000,0,5.8468638,4.6725,7.5515931
 24003,0,10.8493536,2.7945,3.6085695
 24005,0,13.0466599,2.533,2.8323985
 24033,0,10,4,4
+25000,0,10,4,4
 25013,0,12.5,3,3
 25015,0,16.6666667,2,2
 25017,0,16.6666667,2,2
 25023,0,8.3333333,5,5
 25027,0,8.3333333,5,5
+26000,0,1.8889697,21.9927,25.4694563
 26081,0,8.3333333,5,5
 26125,0,7.272911,5.5047,5.8748263
 26161,0,15.7008105,2.0622,2.184549
 26163,0,10.5649607,3.4404,3.7326253
+27000,0,3.5513646,9.1077,13.0790952
 27053,0,12.5,3,3
 27123,0,10.0165767,3.8923,3.9917254
+28000,0,3.3035131,9,14.1354023
+29000,0,5.5555556,6,8
 29077,0,16.6666667,2,2
 29095,0,16.6666667,2,2
+30000,0,5,5,9
+31000,0,10,2.0001,4
 31055,0,10,4,4
+32000,0,12.5,3,3
 32031,0,12.5,3,3
 33011,0,16.6666667,2,2
 33015,0,10,4,4
+34000,0,5.5555556,6,8
 34017,0,12.5,3,3
 34021,0,12.5,3,3
 34025,0,16.6666667,2,2
 34027,0,16.6666667,2,2
 34029,0,12.5,3,3
 34031,0,16.6666667,2,2
+35000,0,12.5,2.9999,3
 35049,0,16.6666667,2,2
+36000,0,1.9761298,20.9374,24.3019819
 36001,0,12.5,3,3
 36005,0,16.6666667,2,2
 36029,0,7.1428571,6,6
@@ -85,18 +114,23 @@ geo_id,val,se,sample_size,effective_sample_size
 36081,0,12.5,3,3
 36091,0,16.6666667,2,2
 36103,0,16.6666667,2,2
+37000,0,1.1653139,27.3893,41.9068928
 37067,0,12.3464038,2.556,3.0497623
 37081,0,11.8284141,3.0548,3.2271094
+39000,0,1.5368234,18.0051,31.5346424
 39007,0,16.2811422,2.002,2.0710376
 39017,0,16.1371088,2.0163,2.0984485
 39035,0,12.5,3,3
 39151,0,12.5,3,3
 39153,0,12.5000223,2.9932,2.9999928
 39155,0,16.6666667,2,2
 39165,0,12.5001278,2.9836,2.9999591
+40000,0,7.1428571,4.7454,6
 40143,0,9.0888754,4.2546,4.5012306
+41000,0,5.3931416,8.0154,8.2710342
 41039,0,10.0003235,3.9846,3.9998382
 41047,0,16.6666667,2,2
+42000,0,3.389111,10.3234,13.7531315
 42003,0,7.8525555,5.124,5.3673539
 42011,0,16.2770598,2.0024,2.0718079
 42017,0,14.7110095,2.1856,2.398815
@@ -112,66 +146,32 @@ geo_id,val,se,sample_size,effective_sample_size
 42091,0,10.2586204,3.1783,3.8739497
 42133,0,12.5,3,3
 44003,0,16.6666667,2,2
+45000,0,3.125,9.0026,15
 45019,0,12.5000032,2.9974,2.999999
 46099,0,12.5,3,3
+47000,0,1.9788949,15.0002,24.2666273
+48000,0,1.1244434,22.1568,43.4664451
 48029,0,7.1506478,5.9009,5.9923735
 48141,0,12.5,3,3
 48157,0,10.8309231,3.2506,3.6164117
 48201,0,9.7174857,3.7476,4.1453639
 48303,0,10.0031441,3.9443,3.9984284
 48439,0,10,4,4
+49000,0,9.2092732,4,4.4293101
 49035,0,16.6666667,2,2
+50000,0,10,3,4
+51000,0,1.5893228,19.9645,30.4599397
 51087,0,13.0877393,2.0354,2.8203695
 51107,0,12.5,3,3
 51710,0,16.6666667,2,2
 51810,0,16.6666667,2,2
+53000,0,4.1666667,9,11
 53011,0,16.6666667,2,2
 53033,0,12.5,3,3
 53061,0,10,4,4
+54000,0,4.5454547,8,9.9999996
 54107,0,16.6666667,2,2
+55000,0,2.2086102,13.4732,21.6386706
 55025,0,13.0842208,2.5268,2.8213968
 55079,0,16.6666667,2,2
-01000,0,4.5174514,6,10.0681877
-02000,0,16.6666667,2,2
-04000,0,10.85673,3.0005,3.6054383
-05000,0,6.25,4,7
-06000,0,2.5,16.0031,19
-08000,0,6.7186362,3.8717,6.4419865
-09000,0,10.0000061,3,3.9999969
-12000,0,1.5229795,23.8825,31.8303826
-13000,0,1.7789135,12.8648,27.1070447
-16000,0,5.3897351,5,8.2768937
-17000,0,1.7119806,18.077,28.2059384
-18000,0,6.25,6,7
-19000,0,2.264424,14.9005,21.0806706
-20000,0,3.1451652,7.9999,14.8974162
-21000,0,4.1455187,8,11.0612167
-22000,0,4.5454545,8,10
-23000,0,7.0889378,6,6.0532429
-24000,0,5.8468638,4.6725,7.5515931
-25000,0,10,4,4
-26000,0,1.8889697,21.9927,25.4694563
-27000,0,3.5513646,9.1077,13.0790952
-28000,0,3.3035131,9,14.1354023
-29000,0,5.5555556,6,8
-30000,0,5,5,9
-31000,0,10,2.0001,4
-32000,0,12.5,3,3
-34000,0,5.5555556,6,8
-35000,0,12.5,2.9999,3
-36000,0,1.9761298,20.9374,24.3019819
-37000,0,1.1653139,27.3893,41.9068928
-39000,0,1.5368234,18.0051,31.5346424
-40000,0,7.1428571,4.7454,6
-41000,0,5.3931416,8.0154,8.2710342
-42000,0,3.389111,10.3234,13.7531315
-45000,0,3.125,9.0026,15
-47000,0,1.9788949,15.0002,24.2666273
-48000,0,1.1244434,22.1568,43.4664451
-49000,0,9.2092732,4,4.4293101
-50000,0,10,3,4
-51000,0,1.5893228,19.9645,30.4599397
-53000,0,4.1666667,9,11
-54000,0,4.5454547,8,9.9999996
-55000,0,2.2086102,13.4732,21.6386706
 56000,0,6.25,5,7