R/syntheszie_tail_ratios.R

In cyplessen/tailRatio: What the Package Does (One Line, Title Case)

#' Syntheszie tail ratios
#'
#' This function synthesizes tail ratios for two groups.
#'
#' @param group_1_mean Mean of group 1/reference group
#' @param group_2_mean Mean of group 2
#' @param group_1_sd Standard deviation of group 1/reference group
#' @param group_2_sd Standard deviation of group 2
#' @param group_1_n Sample size of group 1/reference group
#' @param group_2_n Sample size of group 2
#' @return A table consisting of tail ratios for 1, 2, and 3 SD below the mean of the reference group.
#' @export
synthesize_tail_ratios <- function(group_1_mean, group_1_sd, group_1_n,
                                   group_2_mean, group_2_sd, group_2_n
                                   ) {


  # calculate number of individuals in group 1 below cutoff
  find_group_1_below_cutoff<- function(group_1_mean, group_1_sd, group_1_n,
                                       group_2_mean, group_2_sd, group_2_n,
                                       cutoff) {
    area_below_group_1_mean  <- pnorm(group_2_mean - cutoff * group_1_sd, group_1_mean, group_1_sd, lower.tail = T)
    group_1_n * area_below_group_1_mean
  }

  # calculate number of individuals in group 2 below cutoff
  find_group_2_below_cutoff <- function(group_1_mean, group_1_sd, group_1_n, group_2_mean, group_2_sd, group_2_n, cutoff) {
    area_below_group_2_mean <- pnorm(group_2_mean - cutoff * group_1_sd, group_2_mean, group_2_sd, lower.tail = T)
    group_2_n * area_below_group_2_mean
  }

  # Add number of individuals from group 1/group 2 that are below cutoffs to data
  data_tr <- data  %>%
    dplyr::mutate(group_1_below_TR1 = find_group_1_below_cutoff(group_1_mean = group_1_mean,
                                                                group_1_sd = group_1_sd,
                                                                group_1_n = group_1_n,
                                                                group_2_mean = group_2_mean,
                                                                group_2_sd = group_2_sd,
                                                                group_2_n = group_2_n,
                                                                cutoff = 1)) %>%

    dplyr::mutate(group_2_below_TR1 = find_group_2_below_cutoff(group_1_mean = group_1_mean,
                                                                group_1_sd = group_1_sd,
                                                                group_1_n = group_1_n,
                                                                group_2_mean = group_2_mean,
                                                                group_2_sd = group_2_sd,
                                                                group_2_n = group_2_n,
                                                                cutoff = 1)) %>%

    dplyr::mutate(group_1_below_TR2 = find_group_1_below_cutoff(group_1_mean = group_1_mean,
                                                                group_1_sd = group_1_sd,
                                                                group_1_n = group_1_n,
                                                                group_2_mean = group_2_mean,
                                                                group_2_sd = group_2_sd,
                                                                group_2_n = group_2_n,
                                                                cutoff = 2)) %>%

    dplyr::mutate(group_2_below_TR2 = find_group_2_below_cutoff(group_1_mean = group_1_mean,
                                                                group_1_sd = group_1_sd,
                                                                group_1_n = group_1_n,
                                                                group_2_mean = group_2_mean,
                                                                group_2_sd = group_2_sd,
                                                                group_2_n = group_2_n,
                                                                cutoff = 2)) %>%
    dplyr::mutate(group_1_below_TR3 = find_group_1_below_cutoff(group_1_mean = group_1_mean,
                                                                group_1_sd = group_1_sd,
                                                                group_1_n = group_1_n,
                                                                group_2_mean = group_2_mean,
                                                                group_2_sd = group_2_sd,
                                                                group_2_n = group_2_n,
                                                                cutoff = 3)) %>%

    dplyr::mutate(group_2_below_TR3 = find_group_2_below_cutoff(group_1_mean = group_1_mean,
                                                                group_1_sd = group_1_sd,
                                                                group_1_n = group_1_n,
                                                                group_2_mean = group_2_mean,
                                                                group_2_sd = group_2_sd,
                                                                group_2_n = group_2_n,
                                                                cutoff = 3))


  # Meta-Analytical Synthesis of Relative Risk (FEM and REM)

  ## TR 1 SD below mean
  data_1sd <- metafor::escalc(measure = "RR",
                              ai = group_1_below_TR1,
                              n1i = group_1_n,
                              ci = group_2_below_TR1,
                              n2i = group_2_n,
                              dat = data_tr)

  tr1sd_rr_fem <- metafor::rma(yi, vi, data = data_1sd, method = "FE")
  tr1sd_rr_rem <- metafor::rma(yi, vi, data = data_1sd, method = "REML")


  ## TR 2 SD below mean
  data_2sd <- metafor::escalc(measure  = "RR",
                              ai = group_1_below_TR2,
                              bi = group_1_n - group_1_below_TR2,
                              ci = group_2_below_TR2,
                              di = group_2_n - group_2_below_TR2,
                              dat = data_tr)


  tr2sd_rr_fem <- metafor::rma(yi, vi, dat = data_2sd, method = "FE")
  tr2sd_rr_rem <- metafor::rma(yi, vi, dat = data_2sd, method = "REML")

  # TR 3 SD below mean
  data_3sd <- metafor::escalc(measure = "RR",
                              ai = group_1_below_TR3,
                              bi = group_1_n - group_1_below_TR3,
                              ci = group_2_below_TR3,
                              di = group_2_n - group_2_below_TR3,
                              dat = data_tr)


  tr3sd_rr_fem <- metafor::rma(yi, vi, dat = data_3sd, method = "FE")
  tr3sd_rr_rem <- metafor::rma(yi, vi, dat = data_3sd, method = "REML")

  ## Results


  results_TR <- dplyr::tribble(
    ~"Method", ~"Tailratio", ~"Estimate",                  ~"95% CI Lower",                  ~"95% CI Upper",
    "REM",     "TR1SD",      round(exp(tr1sd_rr_rem$b[1]),3), round(exp(tr1sd_rr_rem$ci.lb[1]),3), round(exp(tr1sd_rr_rem$ci.ub[1]),3),
    "REM",     "TR2SD",      round(exp(tr2sd_rr_rem$b[1]),3), round(exp(tr2sd_rr_rem$ci.lb[1]),3), round(exp(tr2sd_rr_rem$ci.ub),3),
    "REM",     "TR3SD",      round(exp(tr3sd_rr_rem$b[1]),3), round(exp(tr3sd_rr_rem$ci.lb[1]),3), round(exp(tr3sd_rr_rem$ci.ub),3),

    "FEM",     "TR1SD",      round(exp(tr1sd_rr_fem$b[1]),3), round(exp(tr1sd_rr_fem$ci.lb[1]),3), round(exp(tr1sd_rr_fem$ci.ub[1]),3),
    "FEM",     "TR2SD",      round(exp(tr2sd_rr_fem$b[1]),3), round(exp(tr2sd_rr_fem$ci.lb[1]),3), round(exp(tr2sd_rr_fem$ci.ub[1]),3),
    "FEM",     "TR3SD",      round(exp(tr3sd_rr_fem$b[1]),3), round(exp(tr3sd_rr_fem$ci.lb[1]),3), round(exp(tr3sd_rr_fem$ci.ub[1]),3)
  )

  results_TR

}