R/main-meta-function.R

In setgree/ResultsStandardizeR: Some functions that Seth Green & John-Henry Pezzuto wrote to assist with a forthcoming meta-analysis

# main meta function -----------------------------------
meta_engine <- function(df, group_vars){
  df %>%   
    group_by(!!!group_vars) %>% # !!!group_vars ; group_vars = intervention_approach, intervention_type ; cross tabs to analyze
    nest() %>% # make everything into a dataset
    ungroup() %>% 
    mutate(n_effect_sizes = map_int(data, nrow),
           n_studies = map_int(data, ~dplyr::n_distinct(.x$unique_study_id)),
           n_articles = map_int(data, ~dplyr::n_distinct(.x$unique_paper_id))) %>% 
    filter(n_studies > 2) %>% # drop if less than 2 studies
    mutate(meta_main = map(data, ~rma.uni(yi = .x$d, vi = .x$var_d))) %>% 
    mutate(robust_meta = map2(.x = meta_main, 
                              .y = data, 
                              .f = ~robust(x = .x, cluster = .y$unique_paper_id)), # cluster on paper level
           beta = map_dbl(robust_meta, ~unclass(.x)$beta),
           se = map_dbl(robust_meta, ~unclass(.x)$se),
           t = map_dbl(robust_meta, ~unclass(.x)$zval),
           pval = map_dbl(robust_meta, ~unclass(.x)$pval),
           ci.lb = map_dbl(robust_meta, ~unclass(.x)$ci.lb),
           ci.ub = map_dbl(robust_meta, ~unclass(.x)$ci.ub)
    ) %>%
    dplyr::arrange(!!!group_vars)
}



# this double counts based on inputs
meta_analyze <- function(..., treatment_size_greater_than = 0, treatment_size_less_than = Inf, drop_clusters = T, keep_data = F, output_file = F){
  
  group_vars <- enquos(...)
  vars <- map_chr(group_vars, quo_name)
  
  if(drop_clusters) {dat <- dat %>% filter(is.na(n_treatment_clusters)); cluster = "_drop_cluster"
  } else {cluster = ""}
  
  if (treatment_size_greater_than > 0) {t_great = glue("_t>{treatment_size_greater_than}")
  } else {t_great = ""}
  if (treatment_size_less_than < Inf) {t_less = glue("_t<{treatment_size_less_than}")
  } else {t_less = ""}
  
  if(any(vars %in% "intervention_approach")){
    dat <- dat %>%
      pivot_longer(cols = intervention_approach1:intervention_approach2, # double count
                   names_repair = "unique",
                   values_to = "intervention_approach",
                   values_drop_na = T)
  }
  
  if(any(vars %in% "setting")){
    dat <- dat %>% 
      pivot_longer(cols = setting1:setting4,
                   names_repair = "unique",
                   values_to = "setting", 
                   values_drop_na = T) 
  }
  
  if(any(vars %in% "intervention_type")){
    dat <- dat %>% 
      pivot_longer(cols = intervention_type1:intervention_type2,
                   names_repair = "unique",
                   values_to = "intervention_type", 
                   values_drop_na = T) 
  }
  
  if(any(vars %in% "prejudice_type")){
    dat <- dat %>% 
      pivot_longer(cols = prejudice_type1:prejudice_type5, 
                   names_repair = "unique",
                   values_to = "prejudice_type", 
                   values_drop_na = T) 
  }
  
  if(any(vars %in% "outcome_type")){
    dat <- dat %>% 
      pivot_longer(cols = outcome_type1:outcome_type2, 
                   names_repair = "unique",
                   values_to = "outcome_type", 
                   values_drop_na = T)
  }
  
  
  df_collapse <- 
    dat %>%
    filter(n_treatment > treatment_size_greater_than) %>%  # big studies only
    filter(n_treatment < treatment_size_less_than) %>%  # small studies only
    group_by(unique_paper_id, unique_study_id, !!!group_vars) %>% # collapse by **unique_study_id** and relevant vars
    dplyr::summarise(d = mean(d),
              var_d = mean(var_d),
              n_treatment = mean(n_treatment),
              st_err_d = mean(st_err_d)) %>% 
    ungroup()
  
  output <- meta_engine(df_collapse, group_vars)
  
  if(!keep_data) output <- output %>% select(-meta_main, -data, -robust_meta)
  
  filename <- vars %>% paste(collapse = "_x_")
  if(length(group_vars) == 0) filename = "overall_meta"
  print(glue("intermediate_data/{filename}{t_great}{t_less}{cluster}.csv"))
  
  if(output_file) write_csv(output, path = glue("intermediate_data/{filename}{t_great}{t_less}{cluster}.csv"))
  beepr::beep(sound = 2) # surprise for lev that means the program worked
  return(output)
}