R/methods.R

In musicatk: Mutational Signature Comprehensive Analysis Toolkit

#' @title Retrieve musica from a musica_result object
#' @description  The \code{\linkS4class{musica}} musica contains variants, 
#' count tables, and sample annotations
#' @param result A \code{\linkS4class{musica_result}} object generated by
#' a mutational discovery or prediction tool.
#' @rdname musica
#' @return A \code{\linkS4class{musica}} musica object
#' @export
#' @examples
#' data(res)
#' musica(res)
setGeneric(
  name = "musica",
  def = function(result)
  {
    standardGeneric("musica")
  }
)

#' @rdname musica
setMethod(
  f = "musica",
  signature = "musica_result",
  definition = function(result) {
    return(result@musica)
  }
)

#' @title Retrieve table name used for plotting from a musica_result object
#' @description  The table name
#' @param result A \code{\linkS4class{musica_result}} object generated by
#' a mutational discovery or prediction tool.
#' @rdname table_name
#' @return Table name used for plotting
#' @export
#' @examples
#' data(res)
#' table_name(res)
setGeneric(
  name = "table_name",
  def = function(result)
  {
    standardGeneric("table_name")
  }
)

#' @rdname table_name
setMethod(
  f = "table_name",
  signature = "musica_result",
  definition = function(result) {
    return(result@tables)
  }
)

#' @title Retrieve exposures from a musica_result object
#' @description  The \code{exposure} matrix contains estimated amount of
#' each signature for each sample. Rows correspond to each signature and
#' columns correspond to each sample.
#' @param result A \code{\linkS4class{musica_result}} object generated by
#' a mutational discovery or prediction tool.
#' @rdname exposures
#' @return A matrix of exposures
#' @export
#' @examples
#' data(res)
#' exposures(res)
setGeneric(
  name = "exposures",
  def = function(result)
  {
    standardGeneric("exposures")
  }
)

#' @rdname exposures
setMethod(
  f = "exposures",
  signature = "musica_result",
  definition = function(result) {
    return(result@exposures)
  }
)

#' @rdname exposures
#' @param result A \code{\linkS4class{musica_result}} object generated by
#' a mutational discovery or prediction tool.
#' @param value A matrix of samples by signature exposures
#' @export
#' @examples
#' data(res)
#' exposures(res) <- matrix()
setGeneric(
  name = "exposures<-",
  def = function(result, value)
  {
    standardGeneric("exposures<-")
  }
)

#' @rdname exposures
setReplaceMethod(
  f = "exposures",
  signature = c("musica_result", "matrix"),
  definition = function(result, value)
  {
    result@exposures <- value
    return(result)
  }
) 

#' @title Retrieve signatures from a musica_result object
#' @description  The \code{signature} matrix contains the probability of
#' mutation motif in each sample. Rows correspond to each motif and
#' columns correspond to each signature.
#' @param result A \code{\linkS4class{musica_result}} object generated by
#' a mutational discovery or prediction tool.
#' @rdname signatures
#' @return A matrix of mutational signatures
#' @export
#' @examples
#' data(res)
#' signatures(res)
setGeneric(
  name = "signatures",
  def = function(result)
  {
    standardGeneric("signatures")
  }
)

#' @rdname signatures
setMethod(
  f = "signatures",
  signature = "musica_result",
  definition = function(result) {
    return(result@signatures)
  }
)

#' @rdname signatures
#' @param result A \code{\linkS4class{musica_result}} object generated by
#' a mutational discovery or prediction tool.
#' @param value A matrix of motifs counts by samples
#' @export
#' @examples
#' data(res)
#' signatures(res) <- matrix()
setGeneric(
  name = "signatures<-",
  def = function(result, value)
  {
    standardGeneric("signatures<-")
  }
)

#' @rdname signatures
setReplaceMethod(
  f = "signatures",
  signature = c("musica_result", "matrix"),
  definition = function(result, value)
  {
    result@signatures <- value
    return(result)
  }
) 

#' @title Retrieve umap list from a musica_result object
#' @description  The \code{signature} matrix contains the probability of
#' mutation motif in each sample. Rows correspond to each motif and
#' columns correspond to each signature.
#' @param result A \code{\linkS4class{musica_result}} object generated by
#' a mutational discovery or prediction tool.
#' @rdname umap
#' @return A list of umap dataframes
#' @export
#' @examples
#' data(res)
#' umap(res)
setGeneric(
  name = "umap",
  def = function(result)
  {
    standardGeneric("umap")
  }
)

#' @rdname umap
setMethod(
  f = "umap",
  signature = "musica_result",
  definition = function(result) {
    return(result@umap)
  }
)

#' @rdname umap
#' @param result A \code{\linkS4class{musica_result}} object generated by
#' a mutational discovery or prediction tool.
#' @param value A list of umap dataframes
#' @export
#' @examples
#' data(res)
#' umap(res) <- matrix()
setGeneric(
  name = "umap<-",
  def = function(result, value)
  {
    standardGeneric("umap<-")
  }
)

#' @rdname umap
setReplaceMethod(
  f = "umap",
  signature = c("musica_result", "matrix"),
  definition = function(result, value)
  {
    result@umap <- value
    return(result)
  }
) 

#' @title Retrieve variants from a musica or musica_result object
#' @description The \code{variants} \code{data.table} contains the variants 
#' and variant-level annotations
#' @param object A \code{\linkS4class{musica}} object generated by
#' the \link{create_musica} function or a \code{\linkS4class{musica_result}}
#' object generated by a mutational discovery or prediction tool.
#' @rdname variants 
#' @return A data.table of variants
#' @export
#' @examples
#' data(res)
#' variants(res)
setGeneric(
  name = "variants",
  def = function(object)
  {
    standardGeneric("variants")
  }
)

#' @rdname variants
setMethod(
  f = "variants",
  signature = "musica",
  definition = function(object) {
    return(object@variants)
  }
)

#' @rdname variants
setMethod(
  f = "variants",
  signature = "musica_result",
  definition = function(object) {
    return(object@musica@variants)
  }
)

#' @rdname variants
#' @param musica A \code{\linkS4class{musica}} object generated by
#' the \link{create_musica} function
#' @param value A \code{\linkS4class{data.table}} of mutational variants and 
#' variant-level annotations
#' @export
#' @examples
#' data(musica)
#' variants(musica)
setGeneric(
  name = "variants<-",
  def = function(musica, value)
  {
    standardGeneric("variants<-")
  }
)

#' @rdname variants
setReplaceMethod(
  f = "variants",
  signature = c("musica", "data.table"),
  definition = function(musica, value)
  {
    musica@variants <- value
    return(musica)
  }
) 

#' @title Retrieve the list of count_tables from a musica or musica_result 
#' object
#' @description The \code{count_tables} contains standard and/or custom 
#' count tables created from variants
#' @param object A \code{\linkS4class{musica}} object generated by
#' the \link{create_musica} function or a \code{\linkS4class{musica_result}}
#' object generated by a mutational discovery or prediction tool.
#' @rdname tables 
#' @return A list of count_tables
#' @export
#' @examples
#' data(res)
#' tables(res)
setGeneric(
  name = "tables",
  def = function(object)
  {
    standardGeneric("tables")
  }
)

#' @rdname tables
setMethod(
  f = "tables",
  signature = "musica",
  definition = function(object) {
    return(object@count_tables)
  }
)

#' @rdname tables
setMethod(
  f = "tables",
  signature = "musica_result",
  definition = function(object) {
    return(object@musica@count_tables)
  }
)

#' @rdname tables
#' @param musica A \code{\linkS4class{musica}} object generated by
#' the \link{create_musica} function or a \code{\linkS4class{musica_result}}
#' object generated by a mutational discovery or prediction tool.
#' @param value A list of \code{\linkS4class{count_table}} objects representing 
#' counts of motifs in samples
#' @examples
#' data(musica)
#' tables(musica)
#' @export
setGeneric(
  name = "tables<-",
  def = function(musica, value)
  {
    standardGeneric("tables<-")
  }
)

#' @rdname tables
setReplaceMethod(
  f = "tables",
  signature = c("musica", "list"),
  definition = function(musica, value)
  {
    if (length(value) > 0) {
      if(!all(unlist(lapply(value, is, "count_table")))) {
        stop("All objects in the list must be count tables.")
      }
    }
    musica@count_tables <- value
    return(musica)
  }
) 

#' @title Get or set sample annotations from a musica or musica_result object
#' @description  Sample annotations can be used to store information about
#' each sample such as tumor type or treatment status. These are used in 
#' downstream plotting functions such as \code{\link{plot_exposures}} or 
#' \code{\link{plot_umap}} to group or color samples by a particular annotation. 
#' @param object A \code{\linkS4class{musica}} object generated by
#' the \link{create_musica} function or a \code{\linkS4class{musica_result}}
#' object generated by a mutational discovery or prediction tool.
#' @param name The name of the new annotation to add.
#' @param value A vector containing the new sample annotations. Needs to be
#' the same length as the number of samples in the object. 
#' @rdname samp_annot
#' @return A new object with the sample annotations added to the table in the 
#' \code{sample_annotations} slot.
#' @seealso See \code{\link{sample_names}} to get a vector of sample names in 
#' the \code{\linkS4class{musica}} or \code{\linkS4class{musica_result}} object.
#' @export
#' @examples
#' data(res_annot)
#' samp_annot(res_annot)
#' 
#' # Add new annotation
#' samp_annot(res_annot, "New_Annotation") <- rep(c("A", "B"), c(3, 4))
#' samp_annot(res_annot)
setGeneric(
  name = "samp_annot",
  def = function(object)
  {
    standardGeneric("samp_annot")
  }
)

#' @rdname samp_annot
setMethod(
  f = "samp_annot",
  signature = "musica",
  definition = function(object) {
    return(object@sample_annotations)
  }
)

#' @rdname samp_annot
setMethod(
  f = "samp_annot",
  signature = "musica_result",
  definition = function(object) {
    return(object@musica@sample_annotations)
  }
)

#' @rdname samp_annot
#' @examples
#' data(musica)
#' samp_annot(musica, "example") <- rep("ex", 7)
#' @export
setGeneric(
  name = "samp_annot<-",
  def = function(object, name, value)
  {
    standardGeneric("samp_annot<-")
  }
)

#' @rdname samp_annot
setReplaceMethod(
  f = "samp_annot",
  signature = c("musica", "character", "vector"),
  definition = function(object, name, value)
  {
    # Initialize sample annotations in musica object
    if(nrow(samp_annot(object)) == 0) {
      samples <- unique(object@variants$sample)
      sample_dt <- data.table::data.table(Samples = samples)
      object@sample_annotations <- sample_dt
    }
    
    if(length(name) != 1 || !is.character(name)) {
      stop("The 'name' parameter must be a character of length 1.")
    }
    if(length(value) != nrow(object@sample_annotations)) {
      stop("The new sample annotation vector in 'value' must have the ",
           "length as the number of samples in the 'musica' object. Number ",
           "of samples in 'musica' object: ", nrow(object@sample_annotations),
           ". Length of new sample annotation: ",
           length(value), ".")
    }
    object@sample_annotations[[name]] <- value
    return(object)
  }
)  

#' @rdname samp_annot
setReplaceMethod(
  f = "samp_annot",
  signature = c("musica_result", "character", "vector"),
  definition = function(object, name, value)
  {
    samp_annot(object@musica, name) <- value
    return(object)
  }
) 


#' @title Retrieve sample names from a musica or musica_result object
#' @description Sample names were included in the \code{sample} column
#' in the variant object passed to \code{\link{create_musica}}. This returns
#' a unique list of samples names in the order they are inside the 
#' \code{\linkS4class{musica}} object.
#' @param object A \code{\linkS4class{musica}} object generated by
#' the \link{create_musica} function or a \code{\linkS4class{musica_result}}
#' object generated by a mutational discovery or prediction tool.
#' @rdname sample_names
#' @return A character vector of sample names
#' @export
#' @examples
#' data(res)
#' sample_names(res)
setGeneric(
  name = "sample_names",
  def = function(object)
  {
    standardGeneric("sample_names")
  }
)

#' @rdname sample_names
setMethod(
  f = "sample_names",
  signature = "musica",
  definition = function(object) {
    
    if(is.null(object@sample_annotations) ||
       nrow(object@sample_annotations) == 0 ||
       is.null(object@sample_annotations$Sample)) {
      s <- gtools::mixedsort(unique(object@variants$sample))
    } else {
      s <- object@sample_annotations$Sample
    }
    return(s)
  }
)

#' @rdname sample_names
setMethod(
  f = "sample_names",
  signature = "musica_result",
  definition = function(object) {
    return(sample_names(object@musica))
  }
)