_targets.R

In softloud/sperm: Analysis

set.seed(1)

suppressMessages({
  library(tidyverse)
  library(sperm)
  library(janitor)
  library(targets)
  library(multinma)
  library(metafor)
})

conflicted::conflict_prefer("filter", "dplyr")

options(mc.cores = parallel::detectCores())

list.files("R",full.names = TRUE) %>% map(source)




list(
  # clean raw data ----------------------------------------------------------
  tar_target(tidy_dat,
             function(dat, this_outcome) {
               dat %>%
                 clean_names() %>%
                 mutate(across(where(is.character), tolower)) %>%
                 mutate(outcome = this_outcome,
                        # get study
                        study = str_extract(study_id, "\\w+\\s\\d+\\w")) %>%
                 rename(class = major_intervention_grouping,
                        intervention = grouped_intervention,
                        moderator = type_of_infertility) %>%
                 select(outcome, study, everything()) %>%
                 select(-starts_with("x"),
                        -intervention_detailed,
                        -study_id)
             }),


  tar_target(wide_obs,
             map2_df(
               list(count_obs,
                    volume_obs,
                    motility_obs,
                    morphology_obs),
               list("count", "volume", "motility", "morphology"),
               tidy_dat
             )),


  # class needs to be unique for interventions ---------------------------------


  # identify interventions with more than one class label
  tar_target(
    qa_class,
    wide_obs %>%
      group_by(outcome, intervention) %>%
      summarise(
        n_classes = n_distinct(class),
        classes = unique(class) %>% paste(collapse = "; ")
      ) %>%
      filter(n_classes > 1)
  ),

  # identify most-used class labels
  tar_target(
    int_class,
    wide_obs %>%
      count(intervention, class) %>%
      arrange(intervention, desc(n)) %>%
      group_by(intervention) %>%
      filter(class == first(class)) %>%
      select(-n)
  ),

  # patch in unqiue class labels
  tar_target(
    obs_class_fix,
    wide_obs %>%
      select(-class) %>%
      left_join(int_class) %>%
      select(outcome, intervention, class, moderator, study,
             everything())
  ),


  # set model input ---------------------------------------------------------

  tar_target(model_dat,
             obs_class_fix),



# attemp multilevel errors ------------------------------------------------

tar_target(
  obs_control,
  model_dat %>%
    select(outcome, study, starts_with("control"), class) %>%
    group_by(outcome, study) %>%
    mutate(n_per_study = n_distinct(control_n)) %>%
    sample_n(1) %>%
    select(-n_per_study) %>%
    rename_with( ~ str_remove(.x, "control_")) %>%
    rename(intervention = control) %>%
    mutate(
      control = TRUE,
      class = if_else(str_detect(intervention, "placebo"), "placebo", class),
      class = if_else(str_detect(intervention, "supplement"),
                      "dietary supplements",
                      class)
      )

),

tar_target(
  obs_int,
  model_dat %>%
    select(-starts_with("control")) %>%
    rename_with( ~ str_remove(.x, "intervention_")) %>%
    mutate(
      control = FALSE)

),


  tar_target(obs_long,
             bind_rows(obs_control, obs_int) %>%
               arrange(outcome, study, desc(control))
             ),

  tar_target(
    check_classes,
    obs_long %>%
      group_by(intervention) %>%
      summarise(
        class_n = n_distinct(class),
        classes = unique(class) %>% paste(collapse = ";")
      ) %>%
      arrange(desc(class_n))
  ),

  tar_target(
    outcome_groups,
    obs_long %>%
      group_by(outcome) %>%
      tar_group(),
    iteration = "group"

  ),

  tar_target(
    smd_dat,
    outcome_groups %>%
      smd_calc(),
    pattern = map(outcome_groups),
    iteration = "list"
  ),



# fit models --------------------------------------------------------------


tar_target(
  fit_arms,
  set_agd_arm(
    data = smd_dat,
    y = mean,
    se = sd/sqrt(n),
    sample_size = n,
    study = study,
    trt = intervention,
    trt_ref = "placebo/no treatment",
    trt_class = class

  ) %>%
    nma(trt_effects = "random"
        # ,
        # regression = ~.trt:moderator
    ),
  pattern = map(smd_dat)
),

  tar_target(
    fit_nma,
    set_agd_contrast(
      data = smd_dat,
      y = smd,
      se = se_smd,
      sample_size = n,
      study = study,
      trt = intervention,
      trt_ref = "placebo/no treatment",
      trt_class = class

    ) %>%
      nma(trt_effects = "random",
          regression = ~.trt:moderator
          ),
    pattern = map(smd_dat)
  ),


  NULL
)