R/inputSource.R

In OceanTracer: Marine Source Unmixing Toolkit

#' Input Sediment Sources
#'
#' Selects and extracts the source samples from the dataset, computing mean,
#' standard deviation, and sample size (\code{n}) when the input is in raw format.
#' When pre-aggregated data is provided, column names are normalized to 
#' \code{Mean_}/\code{SD_} so that all downstream functions work correctly.
#'
#' @param data Data frame containing source and mixture data.
#' @param na.omit Logical. If \code{TRUE} (default), \code{NA} values are
#'   omitted when computing mean and SD.
#'
#' @return A \code{data.frame} where each row represents a sediment source containing:
#'   \item{id}{Factor or character vector identifying the source group.}
#'   \item{Mean_...}{Mean tracer values for each tracer.}
#'   \item{SD_...}{Standard deviations of tracer values for each tracer.}
#'   \item{n}{Sample size for each source group.}
#'
#' @examples
#' # Example 1: Processing raw sample data
#' raw_df <- data.frame(
#'   ID = paste0("S", 1:9),
#'   Group = rep(c("SourceA", "SourceB", "Mixture"), each = 3),
#'   Tracer1 = c(10, 12, 11, 20, 22, 21, 15, 16, 17),
#'   Tracer2 = c(5, 6, 5, 15, 14, 16, 10, 11, 12)
#' )
#' inputSource(raw_df)
#'
#' # Example 2: Normalizing pre-averaged data with legacy column names
#' summary_df <- data.frame(
#'   ID = c("Src1", "Src2", "Mix"),
#'   Group = c("SourceA", "SourceB", "Mixture"),
#'   mean_Tracer1 = c(11.0, 21.0, 16.0),
#'   mean_Tracer2 = c(5.33, 15.0, 11.0),
#'   sd_Tracer1 = c(1.0, 1.0, 1.0),
#'   sd_Tracer2 = c(0.58, 1.0, 1.0),
#'   n = c(3, 3, 3)
#' )
#' inputSource(summary_df)
#'
#' @export
inputSource <- function(data, na.omit = TRUE) {
  
  # ── Internal helpers ────────────────────────────────────────────────────────
  
  # Detects averaged format regardless of prefix case (Mean_/SD_ or mean_/sd_)
  is_averaged_internal <- function(d) {
    if (sum(grepl("^n$", tolower(colnames(d)))) != 1) return(FALSE)
    if ((ncol(d) - 3) %% 2 != 0) return(FALSE)
    ntracer <- (ncol(d) - 3) / 2
    nms <- colnames(d)[-c(1:2)][1:(2 * ntracer)]
    v1  <- nms[grepl("^[Mm]ean_", nms)]
    v2  <- nms[grepl("^[Ss][Dd]_", nms)]
    length(v1) == ntracer && length(v2) == ntracer &&
      all(gsub("^[Mm]ean_", "", v1) == gsub("^[Ss][Dd]_", "", v2))
  }
  
  # Returns TRUE when prefixes are lowercase
  is_legacy_format <- function(d) {
    any(grepl("^mean_", colnames(d))) || any(grepl("^sd_", colnames(d)))
  }
  
  # Normalizes legacy mean_/sd_ prefixes to OceanTracer Mean_/SD_
  normalise_prefixes <- function(d) {
    colnames(d) <- gsub("^mean_", "Mean_", colnames(d))
    colnames(d) <- gsub("^sd_",   "SD_",   colnames(d))
    d
  }
  
  # ── Averaged format ─────────────────────────────────────────────────────────
  if (is_averaged_internal(data)) {
    if (is_legacy_format(data)) {
      data <- normalise_prefixes(data)
    }
    
    id      <- head(data[, 2], n = -1)
    sources <- cbind(id = id, data[-nrow(data), 3:ncol(data), drop = FALSE])
    return(sources)
  }
  
  # ── Raw format: aggregate to Mean_ / SD_ / n per source group ───────────────
  data[, 2] <- factor(data[, 2], levels = unique(data[, 2]))
  
  # Exclude the last group (assumed to be the mixture)
  source_levels <- levels(data[, 2])
  mix_level     <- source_levels[length(source_levels)]
  
  sources2 <- data[data[, 2] != mix_level, , drop = FALSE]
  sources2 <- sources2[order(sources2[, 2]), ]
  s_groups <- droplevels(sources2[, 2])
  
  data_mean <- stats::aggregate(
    sources2[, 3:ncol(sources2), drop = FALSE],
    by = list(s_groups),
    FUN = mean,
    na.rm = na.omit
  )
  data_mean[[1]] <- NULL
  colnames(data_mean) <- paste0("Mean_", colnames(data_mean))
  
  data_sd <- stats::aggregate(
    sources2[, 3:ncol(sources2), drop = FALSE],
    by = list(s_groups),
    FUN = stats::sd,
    na.rm = na.omit
  )
  data_sd[[1]] <- NULL
  colnames(data_sd) <- paste0("SD_", colnames(data_sd))
  
  n_counts <- as.data.frame(table(s_groups))
  colnames(n_counts) <- c("id", "n")
  
  id      <- n_counts[["id"]]
  n_df    <- data.frame(n = n_counts[["n"]])
  sources <- cbind(id = id, data_mean, data_sd, n_df)
  
  return(sources)
}