R/check_matching2wider.R

In MAICtools: Performing Matched-Adjusted Indirect Comparisons (MAIC)

#' Convert a Longer Table Generated by check_matching() Into a Wider Table
#'
#' @param baseline.longer A data frame containing the summarised results
#' generated by *check_matching()*.
#' @param intervention.arm The name of the grouping column in the data frame
#' specified by *ipds*, e.g., intervention.arm = TRT. The default is TRT.
#' @param digits Specify the number of decimal places for the output results.
#'
#' @importFrom rlang ensym
#' @importFrom assertthat assert_that
#' @importFrom dplyr mutate case_when group_by ungroup transmute
#' @importFrom dplyr select ends_with
#' @importFrom tidyr pivot_wider
#'
#' @return A data frame containing the summarized results in a wider format.
#' @export
#'
#' @examples
#' \donttest{
#' cov <- list(
#'   binary = c("ECOG", "SMK", "METBRAIN"),
#'   continuous = c("BMI", "DIAG")
#' )
#'
#' cov_all <- list(
#'   binary = c("SEX", "ECOG", "SMK", "METBRAIN", "METLIVER"),
#'   continuous = c("BMI", "DIAG", "WEIGHT", "HEIGHT")
#' )
#'
#' baseline <- check_matching(
#'   ipds_wts = pts, agds = AgD_bl,
#'   summary.list = cov_all, matching.list = cov,
#'   intervention.arm = TRT,
#'   comparator = STUDY, comparator.study = "Study XX-1",
#'   comparator.n = N, comparator.arm = TRT)
#'
#' baseline_summary <- check_matching2wider(
#'   baseline.longer = baseline,
#'   intervention.arm = TRT)
#'
#' baseline_summary
#' }
#'
#' @name check_matching2wider
NULL

# 声明全局变量
utils::globalVariables(c("TRT", "statistic", "type", "variable", "src",
                         "category", "value", "adj", "res", "grp"))

check_matching2wider <- function(baseline.longer,
                                 intervention.arm = TRT,
                                 digits = 1) {

  intervention.arm <- rlang::ensym(intervention.arm)

  assertthat::assert_that(
    is.data.frame(baseline.longer),
    msg = "'baseline.longer' is expected to be an output from check_matching()")

  # 检查是否变量都存在在输入数据集中
  missing_vars <- setdiff(c("type",
                            as.character(intervention.arm),
                            "variable", "adj", "src", "statistic", "value"),
                          colnames(baseline.longer))
  if (length(missing_vars) > 0) {
    stop(paste(missing_vars, collapse = ", "),
         " cannot be found in baseline.longer")
  }

  baseline.wider <- baseline.longer %>%
    dplyr::mutate(
      variable = dplyr::case_when(
        statistic %in% c("n", "p", "n_oth", "p_oth")
        ~ paste0(variable, ", n (%)"),
        statistic %in% c("mean", "sd") ~ paste0(variable, ", mean+/-sd"),
        TRUE ~ NA_character_),
      statistic = dplyr::case_when(
        statistic == "mean" ~ "n",
        statistic == "sd" ~ "p",
        TRUE ~ statistic),
      category = dplyr::case_when(
        statistic %in% c("n", "p") ~ "1",
        statistic %in% c("n_oth", "p_oth") ~ "0"),
      statistic = ifelse(statistic == "n_oth", "n", statistic),
      statistic = ifelse(statistic == "p_oth", "p", statistic)
    ) %>%
    dplyr::group_by(type, !!intervention.arm, variable, src, category) %>%
    tidyr::pivot_wider(names_from = statistic, values_from = value) %>%
    dplyr::ungroup() %>%
    dplyr::mutate(
      res = dplyr::case_when(
        type == "binary" ~ paste0(sprintf(paste0("%.", 0, "f"), n),
                                  " (", sprintf(paste0("%.", digits, "f"),
                                                p * 100), ")"),
        type == "continuous" ~ paste0(sprintf(paste0("%.", digits, "f"), n),
                                      " +/- ",
                                      sprintf(paste0("%.", digits, "f"), p)),
        TRUE ~ NA_character_)
    ) %>%
    dplyr::transmute(variable, adj,
                     grp = paste0(!!intervention.arm, "_", src),
                     category, res) %>%
    dplyr::group_by(variable, adj, category) %>%
    tidyr::pivot_wider(names_from = grp, values_from = res) %>%
    dplyr::ungroup() %>%
    dplyr::select(variable, adj, category,
                  dplyr::ends_with("_intervention_pre"),
                  dplyr::ends_with("_intervention_post"),
                  dplyr::ends_with("_comparator"))

  return(baseline.wider)
}