R/formatFoldChangeDataframe.R

In cusom/CUSOM.ShinyHelpers: CU School of Medicine Helper Functions for Shiny Applications

#' Apply standard formatting to fold change dataframe
#'
#' @param .data A dataframe containing fold change data
#' generated by standard fold change calculation
#  should contain these standard columns "Analyte","FoldChange",
#' "log2Foldchange","statistic","p.value","method","alternative",
#' "p.value.original","p.value.adjustment.method","-log10pvalue"
#  group labels are inferred as first 2 columns that do
#' not exist in standard set above
#' @param baselineLabel - string - group label used in
#' the denominator for fold change
#' @param foldchangeStatistic - string - name of statistic used to
#' calculate fold change - defaults to "median"
#' @return a user-firendly formatted data frame
#' @importFrom dplyr select
#' @export
formatFoldChangeDataframe <- function(.data, baselineLabel, foldchangeStatistic = "Median") {

  if(.data$method[1] == "Linear Model") {

    standardColumns <- c("Analyte", "FoldChange",
                         "log2FoldChange", "statistic", "p.value",
                         "method", "alternative", "p.value.original",
                         "p.value.adjustment.method", "-log10pvalue",
                         "lmFormula","ivs")
  } else {

    standardColumns <- c("Analyte", "FoldChange",
                         "log2FoldChange", "statistic", "p.value",
                         "method", "alternative", "p.value.original",
                         "p.value.adjustment.method", "-log10pvalue")
  }

  groupLabels <- setdiff(colnames(.data), standardColumns)

  comparisonLabel <- groupLabels[which(groupLabels != baselineLabel)][1]

  if(is.na(comparisonLabel)) { 
    comparisonLabel <- baselineLabel
  }

  pValueAdjInd <- unique(.data$p.value.adjustment.method) != "none"

  foldChangeDataframe <- .data |>
    dplyr::select(
      Analyte, FoldChange, p.value,
      `p-value (original)` = p.value.original,
      !!comparisonLabel, !!baselineLabel,
      `log<sub>2</sub> Fold Change` = log2FoldChange,
      `-log<sub>10</sub> p-value` = `-log10pvalue`,
      `Statistical test` = method,
      `Adjustment Method` = p.value.adjustment.method
    )

  foldChangeLabel <- ifelse(
    length(groupLabels) == 1,
    glue::glue("Fold Change (per unit of {comparisonLabel})"),
    glue::glue("Fold Change ({comparisonLabel} / {baselineLabel})")
  )

  colnames(foldChangeDataframe)[which(colnames(foldChangeDataframe) == "FoldChange")] <- foldChangeLabel
  colnames(foldChangeDataframe)[which(colnames(foldChangeDataframe) == baselineLabel)] <- glue::glue("{baselineLabel} {foldchangeStatistic}")
  colnames(foldChangeDataframe)[which(colnames(foldChangeDataframe) == comparisonLabel)] <- glue::glue("{comparisonLabel} {foldchangeStatistic}")
  colnames(foldChangeDataframe)[which(colnames(foldChangeDataframe) == "p.value")] <- ifelse(pValueAdjInd,"p-value (adj)", "p-value")

  if (!pValueAdjInd) {

    foldChangeDataframe$`p-value (original)` <- NULL
    foldChangeDataframe$`Adjustment Method` <- NULL

  }

  return(foldChangeDataframe)

}