R/utils.R

Defines functions .prepare_data .resolve_symbols

Documented in .prepare_data .resolve_symbols

# ---- Internal helpers (not exported) ----

#' Resolve gene symbols from row names or an optional annotation table
#'
#' @param dataframe Gene expression data.frame (rows = probes/genes).
#' @param annot_df  Optional annotation data.frame with columns \code{ID} and
#'   one of \code{Gene.Symbol} / \code{Gene.symbol}.  When \code{NULL} (the
#'   default) row names of \code{dataframe} are used as gene identifiers.
#' @return A character vector of gene symbols the same length as
#'   \code{nrow(dataframe)}.
#' @keywords internal
.resolve_symbols <- function(dataframe, annot_df = NULL) {
  if (is.null(annot_df)) {
    return(rownames(dataframe))
  }
  # Detect symbol column
  sym_col <- if ("Gene.Symbol" %in% colnames(annot_df)) {
    "Gene.Symbol"
  } else if ("Gene.symbol" %in% colnames(annot_df)) {
    "Gene.symbol"
  } else {
    warning("Could not find 'Gene.Symbol' or 'Gene.symbol' in annot_df; ",
            "using row names instead.")
    return(rownames(dataframe))
  }
  annot_df <- annot_df[!duplicated(annot_df$ID), ]
  ID <- data.frame(GeneID = rownames(dataframe), stringsAsFactors = FALSE)
  merged <- merge(ID, annot_df, by.x = "GeneID", by.y = "ID", all.x = TRUE,
                  sort = FALSE)
  # Keep original order
  merged <- merged[match(ID$GeneID, merged$GeneID), ]
  raw_sym <- as.character(merged[[sym_col]])
  # Take the first symbol when multiple are separated by " /// "
  sapply(strsplit(raw_sym, " /// "), function(x) x[[1]])
}

#' Apply log2 normalisation if the data appear to be on a linear scale
#'
#' @param dataframe Numeric data.frame.
#' @param con1,con2,exp1,exp2 Column indices.
#' @return A list with \code{dataframe} (possibly log2-transformed),
#'   \code{con}, \code{exp}, \code{con_m}, \code{exp_m}, \code{log2FC},
#'   and logical \code{log_transformed}.
#' @keywords internal
.prepare_data <- function(dataframe, con1, con2, exp1, exp2) {
  con <- dataframe[, con1:con2, drop = FALSE]
  exp <- dataframe[, exp1:exp2, drop = FALSE]
  con_m <- rowMeans(con, na.rm = TRUE)
  exp_m <- rowMeans(exp, na.rm = TRUE)
  
  xm2 <- as.numeric(quantile(as.matrix(dataframe),
                             c(0, 0.25, 0.5, 0.75, 0.99, 1),
                             na.rm = TRUE))
  LogC <- (xm2[5] > 100) || (xm2[6] - xm2[1] > 50 && xm2[2] > 0)
  
  if (LogC) {
    dataframe <- log2(dataframe + 1)
    con   <- dataframe[, con1:con2, drop = FALSE]
    exp   <- dataframe[, exp1:exp2, drop = FALSE]
    con_m <- rowMeans(con, na.rm = TRUE)
    exp_m <- rowMeans(exp, na.rm = TRUE)
  }
  log2FC <- exp_m - con_m
  list(dataframe = dataframe, con = con, exp = exp,
       con_m = con_m, exp_m = exp_m, log2FC = log2FC,
       log_transformed = LogC)
}

Try the DGEAR package in your browser

Any scripts or data that you put into this service are public.

DGEAR documentation built on July 3, 2026, 9:07 a.m.