R/contrast_padjust.R

In fdrennan/test: What the Package Does (One Line, Title Case)

#' contrast_padjust
#' @export contrast_padjust
#'
contrast_padjust <- function(model, contrast_list, data, variable) {
  # est <- emmeans(
  #   object = model, ~ Treatment * Time,
  #   adjust = "none", data = data,
  #   mode = "df.error"
  # )
  data <- data %>% rename(tmp = variable)
  est <- emmeans(
    object = model, ~ TreatmentNew * Time,
    adjust = "none", data = data,
    mode = "auto"
  )

  est_me <- emmeans(
    object = model, ~TreatmentNew, adjust = "none", data = data,
    mode = "auto"
  )

  final_contrast <- map_df(.x = LETTERS[1:9], .f = ~ {
    print(.x)
    # Maybe there is a way to have NA for contrasts that don't exist
    out <- final_contrasts(model = model, cont_list = contrast_list[[.x]], est = est)
    if (!is.null(out)) {
      num_pairs <- nrow(out) / 2
      if (.x == "G") {
        if (num_pairs == 1) {
          rownames(out) <- c("G12", "G12_st")
        } else {
          rownames(out) <- cbind(combn(1:num_pairs, 2), combn(1:num_pairs, 2)) %>%
            t() %>%
            data.frame() %>%
            arrange(X1, X2) %>%
            mutate(final = case_when(
              row_number() %% 2 == 1 ~ paste0("G", X1, X2),
              row_number() %% 2 == 0 ~ paste0("G", X1, X2, "_st")
            )) %>%
            select(final) %>%
            unlist()
        }
      } else if (num_pairs == 1) {
        rownames(out) <- c(.x, paste0(.x, "_st"))
      } else {
        rownames(out) <- c(
          paste(.x, 1:num_pairs, sep = ""),
          paste(.x, 1:num_pairs, "_st",
            sep = ""
          )
        )
      }
      return(out %>% select(-contrast))
    }
  })
  return(list(
    final_contrast = final_contrast,
    emmeans_obj = list(
      AT = est_me,
      ST = est
    )
  ))
}