Reading study parameters with hiddenmeta

Load packages

library(hiddenmeta)
library(DeclareDesign)
library(knitr)

seed <- 871223

study_diagnosands <-
 declare_diagnosands(
    mean_estimand = mean(estimand),
    mean_estimate = mean(estimate),
    sd_estimate = sd(estimate),
    mean_se = mean(se),
    bias = mean(estimate - estimand),
    rmse = sqrt(mean((estimate - estimand) ^ 2))
  )

Read study designs

• The Google spreadsheet with the current study designs can be found here (access restricted)
• Currently only spreadsheets of the format presented at the link are supported
• To load the spreadsheet you need to provide authentication e-mail and when reading the parameters you will be asked to log in into your Google account
• In addition the function currently allows to specify spreadsheet ID and specific sheet name within the spreadsheet to use for reading

googlesheets4::gs4_auth(email = "gerasy@gmail.com")

study_designs <- 
  read_study_params(
    ss = "1HwMM6JwoGALLMTpC8pQRVzaQdD2X71jpZNhfpKTnF8Y",
    sheet = "study_params_readable"
  )

saveRDS(study_designs, file = here::here("inst/extdata/study_designs.rds"))

study_designs <- 
  readRDS(system.file("extdata", "study_designs.rds", package = "hiddenmeta"))

Declare studies separately

design <- study_designs$ff_brazil

study_population <-
  eval(as.call(c(list(declare_population), design$pop)))

study_sample_rds <- 
  eval(as.call(c(list(declare_sampling), design$samples$rds)))

study_sample_pps <-
  eval(as.call(c(list(declare_sampling), design$samples$pps)))

# study_sample_tls <- 
#   eval(as.call(c(list(declare_sampling), design$samples$tls)))

study_estimands <- 
  eval(as.call(c(list(declare_inquiry), design$inquiries)))

est_sspse <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds$sspse)))
est_chords <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds$chords)))
est_multi <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds$multiplier)))

est_ht_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$pps$ht)))
est_nsum_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$pps$nsum)))

est_recap_rds_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds_pps$recap1)))

# est_ht_tls <- 
#   eval(as.call(c(list(declare_estimator), design$estimators$tls$ht)))
# est_nsum_tls <- 
#   eval(as.call(c(list(declare_estimator), design$estimators$tls$nsum)))
# est_recap_tls <- 
#   eval(as.call(c(list(declare_estimator), design$estimators$tls$recap)))

study <- 
  study_population +
                 study_sample_rds + 
                 study_sample_pps + 
                 # study_sample_tls +
                 study_estimands +
                 est_sspse +
                 est_chords +
                 est_multi +
                 est_nsum_pps +
                 est_ht_pps +
                 # est_nsum_tls + 
                 # est_ht_tls + 
                 # est_recap_tls +
                 est_recap_rds_pps #+
                 # est_recap_rds_tls

set.seed(seed)
diagnose_design(study, sims = 1, 
                diagnosands = study_diagnosands) %>% 
  reshape_diagnosis %>% select(-'Design') %>%
  kable()

design <- study_designs$umass_tunisia

study_population <-
  eval(as.call(c(list(declare_population), design$pop)))

study_sample_tls <- 
  eval(as.call(c(list(declare_sampling), design$samples$tls)))

study_estimands <- 
  eval(as.call(c(list(declare_inquiry), design$inquiries)))

est_ht_tls <- 
  eval(as.call(c(list(declare_estimator), design$estimators$tls$ht)))
est_nsum_tls <- 
  eval(as.call(c(list(declare_estimator), design$estimators$tls$nsum)))
est_recap_tls <- 
  eval(as.call(c(list(declare_estimator), design$estimators$tls$recap)))

study <- 
  study_population + study_sample_tls + study_estimands + 
  est_nsum_tls + est_ht_tls + est_recap_tls

set.seed(seed)
diagnose_design(study, sims = 1, 
                diagnosands = study_diagnosands) %>% 
  reshape_diagnosis %>% select(-'Design') %>%
  kable()

design <- study_designs$stanford_brazil

study_population <-
  eval(as.call(c(list(declare_population), design$pop)))

study_sample_pps <-
  eval(as.call(c(list(declare_sampling), design$samples$pps)))

study_estimands <- 
  eval(as.call(c(list(declare_inquiry), design$inquiries)))

est_ht_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$pps$ht)))
est_nsum_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$pps$nsum)))

study <- 
  study_population + study_sample_pps +  study_estimands + 
  est_nsum_pps + est_ht_pps

set.seed(seed)
diagnose_design(study, sims = 1, 
                diagnosands = study_diagnosands) %>% 
  reshape_diagnosis %>% select(-'Design') %>%
  kable()

design <- study_designs$jhu_pakistan

study_population <-
  eval(as.call(c(list(declare_population), design$pop)))

study_sample_rds <- 
  eval(as.call(c(list(declare_sampling), design$samples$rds)))
study_sample_pps <-
  eval(as.call(c(list(declare_sampling), design$samples$pps)))


study_estimands <- 
  eval(as.call(c(list(declare_inquiry), design$inquiries)))

est_sspse <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds$sspse)))
# est_chords <-
#   eval(as.call(c(list(declare_estimator), design$estimators$rds$chords)))

est_ht_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$pps$ht)))
est_nsum_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$pps$nsum)))

est_recap_rds_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds_pps$recap1)))

study <- 
  study_population + study_sample_rds +  study_sample_pps +  study_estimands + 
  est_sspse + est_nsum_pps + est_ht_pps + est_recap_rds_pps #+ est_chords 

set.seed(seed)
diagnose_design(study, sims = 1, 
                diagnosands = study_diagnosands) %>% 
  reshape_diagnosis %>% select(-'Design') %>%
  kable()

design <- study_designs$nyu_costarica

study_population <-
  eval(as.call(c(list(declare_population), design$pop)))

study_sample_rds <- 
  eval(as.call(c(list(declare_sampling), design$samples$rds)))
study_sample_pps <-
  eval(as.call(c(list(declare_sampling), design$samples$pps)))


study_estimands <- 
  eval(as.call(c(list(declare_inquiry), design$inquiries)))

est_sspse <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds$sspse)))
# est_chords <- 
#   eval(as.call(c(list(declare_estimator), design$estimators$rds$chords)))

est_ht_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$pps$ht)))
est_nsum_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$pps$nsum)))

est_recap_rds_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds_pps$recap1)))

study <- 
  study_population + study_sample_rds +  study_sample_pps +  study_estimands + 
  est_sspse + est_nsum_pps + est_ht_pps + est_recap_rds_pps # + est_chords

set.seed(seed)
diagnose_design(study, sims = 1, 
                diagnosands = study_diagnosands) %>% 
  reshape_diagnosis %>% select(-'Design') %>%
  kable()

design <- study_designs$nyu_tanzania

study_population <-
  eval(as.call(c(list(declare_population), design$pop)))

study_sample_rds <- 
  eval(as.call(c(list(declare_sampling), design$samples$rds)))
study_sample_pps <-
  eval(as.call(c(list(declare_sampling), design$samples$pps)))


study_estimands <- 
  eval(as.call(c(list(declare_inquiry), design$inquiries)))

est_sspse <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds$sspse)))
est_chords <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds$chords)))

est_ht_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$pps$ht)))
est_nsum_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$pps$nsum)))

est_recap_rds_pps <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds_pps$recap1)))

study <- 
  study_population + study_sample_rds +  study_sample_pps +  study_estimands + 
  est_sspse + est_chords + est_nsum_pps + est_ht_pps + est_recap_rds_pps

set.seed(seed)
diagnose_design(study, sims = 1, 
                diagnosands = study_diagnosands) %>% 
  reshape_diagnosis %>% select(-'Design') %>%
  kable()

design <- study_designs$norc_marocco

study_population <-
  eval(as.call(c(list(declare_population), design$pop)))

study_sample_rds <- 
  eval(as.call(c(list(declare_sampling), design$samples$rds)))
study_sample_tls <-
  eval(as.call(c(list(declare_sampling), design$samples$tls)))

study_estimands <- 
  eval(as.call(c(list(declare_inquiry), design$inquiries)))

est_sspse <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds$sspse)))
est_chords <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds$chords)))

est_ht_tls <-
  eval(as.call(c(list(declare_estimator), design$estimators$tls$ht)))
est_nsum_tls <-
  eval(as.call(c(list(declare_estimator), design$estimators$tls$nsum)))
est_recap_tls <-
  eval(as.call(c(list(declare_estimator), design$estimators$tls$recap)))

est_recap_rds_tls <-
  eval(as.call(c(list(declare_estimator), design$estimators$rds_tls$recap2)))

study <- 
  study_population + study_sample_rds +  study_sample_tls + study_estimands + 
  est_sspse + est_nsum_tls + est_ht_tls + est_recap_tls + est_recap_rds_tls + est_chords

set.seed(seed)
diagnose_design(study, sims = 1, 
                diagnosands = study_diagnosands) %>% 
  reshape_diagnosis %>% select(-'Design') %>%
  kable()

design <- study_designs$rti_usa

study_population <-
  eval(as.call(c(list(declare_population), design$pop)))

study_sample_rds <- 
  eval(as.call(c(list(declare_sampling), design$samples$rds)))
study_sample_tls <-
  eval(as.call(c(list(declare_sampling), design$samples$tls)))

study_estimands <- 
  eval(as.call(c(list(declare_inquiry), design$inquiries)))

est_sspse <- 
  eval(as.call(c(list(declare_estimator), design$estimators$rds$sspse)))
# est_chords <- 
#   eval(as.call(c(list(declare_estimator), design$estimators$rds$chords)))

est_ht_tls <-
  eval(as.call(c(list(declare_estimator), design$estimators$tls$ht)))
est_nsum_tls <-
  eval(as.call(c(list(declare_estimator), design$estimators$tls$nsum)))
est_recap_tls <-
  eval(as.call(c(list(declare_estimator), design$estimators$tls$recap)))

est_recap_rds_tls <-
  eval(as.call(c(list(declare_estimator), design$estimators$rds_tls$recap2)))

study <- 
  study_population + study_sample_rds +  study_sample_tls + study_estimands + 
  est_sspse + est_nsum_tls + est_ht_tls + est_recap_tls + est_recap_rds_tls #+ est_chords

set.seed(seed)
diagnose_design(study, sims = 1, 
                diagnosands = study_diagnosands) %>% 
  reshape_diagnosis %>% select(-'Design') %>%
  kable()

Declare all studies together

multi_population <- 
  declare_population(handler = get_multi_populations, 
                     pops_args = sapply(study_designs, 
                                        function(x) x$pop, 
                                        simplify = FALSE))

multi_sampling <- 
  declare_sampling(handler = get_multi_samples,
                   samples_args = sapply(study_designs, 
                                        function(x) x$samples, 
                                        simplify = FALSE)) 

multi_inquiry <- 
  declare_inquiry(handler = get_multi_estimands, 
                  inquiries_args = sapply(study_designs, 
                                        function(x) x$inquiries, 
                                        simplify = FALSE)) 

multi_estimators <-
  declare_estimator(handler = get_multi_estimates,
                    estimators_args = sapply(study_designs, 
                                             function(x) x$estimators, 
                                             simplify = FALSE))

multi_study <- multi_population + multi_sampling + multi_inquiry + multi_estimators

set.seed(seed)
diagnose_design(multi_study, sims = 1,
                diagnosands = study_diagnosands) %>%
  reshape_diagnosis %>% select(-'Design') %>%
  kable()

set.seed(seed)
multi_study_data <- draw_data(multi_study)


saveRDS(multi_study_data, file = here::here("inst/extdata/multi_sim_data_draw.rds"))

Generate required data

multi_study_data <- 
  readRDS(system.file("extdata", "multi_sim_data_draw.rds", package = "hiddenmeta"))

( data_require_base <- get_required_data(multi_study_data) )
#> # A tibble: 21 × 12
#>    Variable  Label Type  Example Brazi…¹ Tunis…² Brazi…³ Pakis…⁴ Costa…⁵ Tanza…⁶
#>    <chr>     <chr> <chr> <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>  
#>  1 name      Resp… inte… "556;1… X       "X"     "X"     X       X       X      
#>  2 hidden    Hidd… inte… "0;1"   X       "X"     "X"     X       X       X      
#>  3 hidden_v… Know… nume… "1;0;5… X       "X"     "X"     X       X       X      
#>  4 hidden_v… Know… nume… "0;23"  X       "X"     "X"     X       X       X      
#>  5 rds       RDS:… inte… "0"     X       ""      ""      X       X       X      
#>  6 rds_from  RDS:… nume… "9988;… X       ""      ""      X       X       X      
#>  7 rds_t     RDS:… nume… "370.3… X       ""      ""      X       X       X      
#>  8 rds_wave  RDS:… nume… "4;5;2… X       ""      ""      X       X       X      
#>  9 rds_hidd… RDS:… inte… ""      X       ""      ""      X       X       X      
#> 10 rds_own_… RDS:… char… ";81;2… X       ""      ""      X       X       X      
#> # … with 11 more rows, 2 more variables: `Morocco (NORC)` <chr>,
#> #   `USA (RTI)` <chr>, and abbreviated variable names ¹​`Brazil (FF)`,
#> #   ²​`Tunisia (UMass)`, ³​`Brazil (Stanford)`, ⁴​`Pakistan (JHU)`,
#> #   ⁵​`Costa Rica (John Jay)`, ⁶​`Tanzania (John Jay)`