R/class_count_table.R

In campbio/musicatk: Mutational Signature Comprehensive Analysis Toolkit

#' @importFrom utils capture.output
NULL

# Count Tables object/methods -------------------------------

#' Object containing the count table matrices, their names and descriptions
#' that we generated by provided and by user functions. These are used to
#' discover and infer signatures and exposures.
#'
#' @slot name A name that describes the type of table (e.g. "SBS96")
#' @slot count_table An array of counts with samples as the columns and motifs
#' as the rows
#' @slot annotation A data.frame of annotations with three columns used for
#' plotting: motif, mutation, and context
#' @slot features Original features used to generate the count_table
#' @slot type The mutation type of each feature, in case we need to plot or
#' model they differently
#' @slot color_variable The variable used for plotting colors, selected from
#' the annotation slot
#' @slot color_mapping The mapping of the annotations chosen by color_variable
#' to color values for plotting
#' @slot description A summary table of the result objects in result_list
#' a list of lists. The nested lists created combined (rbind) tables, and the
#' tables at the first list level are modelled independantly. Combined tables
#' must be named.
#' list("tableA", comboTable = list("tableC", "tableD"))
#' @importFrom S4Vectors Rle
#' @export
setClass("count_table", slots = c(
  name = "character",
  count_table = "array",
  annotation = "data.frame",
  features = "data.frame",
  type = "Rle",
  color_variable = "character",
  color_mapping = "character",
  description = "character"
))

setMethod(
  "show", "count_table",
  function(object) {
    cat(
      "Count_Table: ", object@name,
      c(
        "\nMotifs:", dim(object@count_table)[1],
        "\nSamples:", dim(object@count_table)[2],
        "\n"
      ),
      "\n**Annotations: \n",
      paste(
        capture.output(rbind(head(
          object@annotation
        ), "...")),
        collapse = "\n"
      ),
      "\n\n**Features: \n",
      paste(
        capture.output(rbind(head(
          object@features
        ), "...")),
        collapse = "\n"
      ),
      "\n\n**Types: \n",
      paste0(unique(object@type), "\n"),
      "\n**Color Variable: \n",
      paste0(object@color_variable, "\n"),
      "\n**Color Mapping: \n",
      paste0(object@color_mapping, "\n"),
      "\n**Descriptions: \n",
      paste0(object@description, "\n")
    )
  }
)

get_tab_name <- function(count_table) {
  return(count_table@name)
}

#' @title Retrieve count_table matrix from count_table object
#' @description  The count table
#' @param count_table A \code{\linkS4class{count_table}} object.
#' @rdname get_count_table
#' @return The count table
#' @export
get_count_table <- function(count_table) {
  return(count_table@count_table)
}

get_annot_tab <- function(count_table) {
  return(count_table@annotation)
}

get_count_features <- function(count_table) {
  return(count_table@features)
}

get_count_type <- function(count_table) {
  return(count_table@type)
}

get_color_mapping <- function(count_table) {
  return(count_table@color_mapping)
}