Project: s41467-025-61697-y | Function: createCompass (r)

system: You are an expert R programmer implementing algorithms from scientific papers.
Complete the masked function based on the algorithm description.
Follow R best practices and maintain consistent code style.
Return **only** the complete R function code.

user: Complete this R function:

**DESCRIPTION:** Create Compass object for metabolic analysis. Implements constructor for Compass methodology that analyzes cellular metabolism from single-cell RNA-seq data.

**KEY TERMS:** {
  "Compass": "metabolic analysis framework",
  "createCompass": "object constructor"
}

**CONTEXT CODE:** #' @importFrom enONE countReplicate
#' @importFrom S4Vectors DataFrame
#' @importFrom SummarizedExperiment SummarizedExperiment
#' @rdname createCompass
#' @export
#'
setClass(
  Class = "Compass",
  contains = "SummarizedExperiment",
  slots = list(
    counts = "list",
    norm_factors = "list",
    ratio = "list",
    ratio_filtered = "list",
    ratio_shrunk = "list",
    parameter = "list"
  )
)

#' Compass object and constructor
#'
#' @description \code{Compass} object extends the \code{SummarizedExperiment} class.
#' The \code{createCompass} is a easy constructor of \code{Compass} object
#'
#' @param data A un-normalized count data matrix of shape n x p, where n is the
#'   number of samples and p is the number of features.
#' @param col.data \code{data.frame} with at least two columns (indicate condition and enrich groups).
#'   Rows of \code{col.data} correspond to columns of \code{data}.
#' @param spike.in.prefix A character specify the prefix of spike-in id, e.g., "^FB" stands for gene id of fly spike-in , default: NULL.
#' @param input.id Input library id, must be consistent with \code{enrich.group}, e.g., "Input".
#' @param enrich.id Enrich library id, must be consistent with \code{enrich.group}, e.g., "Enrich".
#' @param synthetic.id Vector of synthetic RNA id, e.g. c("Syn1","Syn2"), default: NULL.
#'
#' @return Compass object
#'
#' @details Description of each slot:
#'   \code{assay} \code{SummarizedExperiment::Assays} object, contains all counts.
#'   \code{counts} list for holding raw/normalized counts of sample and spike_in.
#'   \code{norm_factors} list for holding normalization factors of sample and spike_in.
#'   \code{ratio} list for holding the ratio of all genes.
#'   \code{ratio_filtered} lists for holding the ratio of genes with ratios smaller than 1 in all samples.
#'   \code{ratio_shrunk} lists for holding the ratio after shrinkage.
#'   \code{parameter} list of parameters.
#'
#' @export
#'
#' @importFrom methods validObject
#' @importFrom enONE countReplicate
#' @importFrom S4Vectors DataFrame
#' @importFrom SummarizedExperiment SummarizedExperiment
createCompass <- function(data,
                          col.data,
                          spike.in.prefix = NULL,
                          input.id = "Input",
                          enrich.id = "Enrich",
                          synthetic.id = NULL) {
  stop("Function implementation has been masked")
}

setValidity("Compass", function(object) {

  # check input.id and enrich.id match the enrich.group
  if (!all(c(object@parameter$input.id, object@parameter$enrich.id) %in% object@enrich)) {
    return("The `input.id` and/or `enrich.id` must be the same as `enrich.group`.")
  }

  # check spike.in.prefix match the rownames
  if (length(grep(object@parameter$spike.in.prefix, rownames(object))) < 1) {
    return("The `spike.in.prefix` does not match the rownames in the count matrix.")
  }

  # check synthetic.id match the rownames
  if (!is.null(object@parameter$synthetic.id) & !all(object@parameter$synthetic.id %in% rownames(object))) {
    return("The `synthetic.id` are not presented in the rownames of count matrix.")
  }

  # check length of bio.group match the sample size
  if (length(object$condition) != ncol(object)) {
    return("The number of elements in `bio.group` does not match the sample size.")
  }

  # check length of enrich.group match the sample size
  if (length(object$enrich) != ncol(object)) {
    return("The number of elements in enrich.group` does not match the sample size.")
  }

  # check length of batch.group match the sample size
  if (!all(is.na(object$batch)) & length(object$batch) != ncol(object)) {
    return("The number of elements in `batch.group` does not match the sample size.")
  }
})

setValidity("Compass", function(object) {

  # check input.id and enrich.id match the enrich.group
  if (!all(c(object@parameter$input.id, object@parameter$enrich.id) %in% object$enrich)) {
    return("The `input.id` and/or `enrich.id` must be the same as `enrich.group`.")
  }

  # check spike.in.prefix match the rownames
  if (length(grep(object@parameter$spike.in.prefix, rownames(object))) < 1) {
    return("The `spike.in.prefix` does not match the rownames in the count matrix.")
  }

  # check synthetic.id match the rownames
  if (!is.null(object@parameter$synthetic.id) & !all(object@parameter$synthetic.id %in% rownames(object))) {
    return("The `synthetic.id` are not presented in the rownames of count matrix.")
  }

  # check length of bio.group match the sample size
  if (length(object$condition) != ncol(object)) {
    return("The number of elements in `bio.group` does not match the sample size.")
  }

  # check length of enrich.group match the sample size
  if (length(object$enrich) != ncol(object)) {
    return("The number of elements in enrich.group` does not match the sample size.")
  }

  # check length of batch.group match the sample size
  if (!all(is.na(object$batch)) & length(object$batch) != ncol(object)) {
    return("The number of elements in `batch.group` does not match the sample size.")
  }
})


Complete the function implementation replacing "stop("Not implemented")".