R/class_result_model.R

#' Object that contains results for a single model
#'
#' @slot signatures A matrix of signatures by mutational motifs
#' @slot exposures A matrix of samples by signature weights
#' @slot num_signatures Number of signatures in the model
#' @slot other_parameters Parameters relevant to the model
#' @slot credible_intervals Credible intervals for parameters
#' @slot metrics Performance metrics for the model
#' @slot umap List of umap data.frames for plotting and analysis
#' @slot model_id Model identifier
#' @slot modality Modality of result (SBS96, DBS78, IND83)
#' @export
#' @exportClass result_model

setClass(
  "result_model",
  slots = list(
    signatures = "matrix",
    exposures = "matrix",
    num_signatures = "numeric",
    other_parameters = "SimpleList",
    credible_intervals = "SimpleList",
    metrics = "SimpleList",
    umap = "matrix",
    model_id = "character",
    modality = "character"
  )
)

#' @title Retrieve exposures from a result_model, result_collection, or musica
#' 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 x A \code{\linkS4class{result_model}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{musica}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list that contains the desired
#' exposures. Used when \code{result} is a \code{\linkS4class{musica}} object.
#' @param modality Modality that contains the desired exposures. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier that contains the desired exposures. Used
#' when \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @rdname exposures
#' @return A matrix of exposures
#' @export
#' @examples
#' data(res)
#' exposures(res, "result", "SBS96", "res")
setGeneric(
  name = "exposures",
  def = function(x, ...) {
    standardGeneric("exposures")
  }
)

#' @rdname exposures
setMethod(
  f = "exposures",
  signature = "musica",
  definition = function(x, result, modality, model_id) {
    return(x@result_list[[result]]@modality[[modality]][[model_id]]@exposures)
  }
)

#' @rdname exposures
setMethod(
  f = "exposures",
  signature = "result_collection",
  definition = function(x, modality, model_id) {
    return(x@modality[[modality]][[model_id]]@exposures)
  }
)

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

#' @rdname exposures
#' @param x A \code{\linkS4class{musica}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{result_model}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list to assign the exposures.
#' Used when \code{result} is a \code{\linkS4class{musica}} object.
#' @param modality Modality to assign the exposures. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier to assign the exposures. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param ... Other inputs
#' @param value A matrix of samples by signature exposures
#' @export
#' @examples
#' data(res)
#' exposures(res, "result", "SBS96", "res") <- matrix()
setGeneric(
  name = "exposures<-",
  def = function(x, ..., value) {
    standardGeneric("exposures<-")
  }
)

#' @rdname exposures
setReplaceMethod(
  f = "exposures",
  signature = c("musica", "matrix"),
  definition = function(x, result, modality, model_id, value) {
    x@result_list[[result]]@modality[[modality]][[model_id]]@exposures <- value
    return(x)
  }
)

#' @rdname exposures
setReplaceMethod(
  f = "exposures",
  signature = c("result_collection", "matrix"),
  definition = function(x, modality, model_id, value) {
    x@modality[[modality]][[model_id]]@exposures <- value
    return(x)
  }
)

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

#' @title Retrieve signatures from a result_model, result_collection, or musica
#' object
#' @description  The \code{signatures} matrix contains the probability of
#' mutation motif in each sample. Rows correspond to each motif and
#' columns correspond to each signature.
#' @param x A \code{\linkS4class{result_model}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{musica}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list that contains the desired
#' signatures. Used when \code{result} is a \code{\linkS4class{musica}} object.
#' @param modality Modality that contains the desired signatures. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier that contains the desired signatures. Used
#' when \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @rdname signatures
#' @return A matrix of mutational signatures
#' @export
#' @examples
#' data(res)
#' signatures(res, "result", "SBS96", "res")
setGeneric(
  name = "signatures",
  def = function(x, ...) {
    standardGeneric("signatures")
  }
)

#' @rdname signatures
setMethod(
  f = "signatures",
  signature = "musica",
  definition = function(x, result, modality, model_id) {
    return(x@result_list[[result]]@modality[[modality]][[model_id]]@signatures)
  }
)

#' @rdname signatures
setMethod(
  f = "signatures",
  signature = "result_collection",
  definition = function(x, modality, model_id) {
    return(x@modality[[modality]][[model_id]]@signatures)
  }
)

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

#' @rdname signatures
#' @param x A \code{\linkS4class{musica}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{result_model}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list to assign the signatures.
#' Used when \code{result} is a \code{\linkS4class{musica}} object.
#' @param modality Modality to assign the signatures. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier to assign the signatures. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param ... Other inputs
#' @param value A matrix of motifs counts by samples
#' @export
#' @examples
#' data(res)
#' signatures(res, "result", "SBS96", "res") <- matrix()
setGeneric(
  name = "signatures<-",
  def = function(x, ..., value) {
    standardGeneric("signatures<-")
  }
)

#' @rdname signatures
setReplaceMethod(
  f = "signatures",
  signature = c("musica", "matrix"),
  definition = function(x, result, modality, model_id, value) {
    x@result_list[[result]]@modality[[modality]][[model_id]]@signatures <- value
    return(x)
  }
)

#' @rdname signatures
setReplaceMethod(
  f = "signatures",
  signature = c("result_collection", "matrix"),
  definition = function(x, modality, model_id, value) {
    x@modality[[modality]][[model_id]]@signatures <- value
    return(x)
  }
)

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

#' @title Retrieve num_signatures from a result_model, result_collection, or
#' musica object
#' @description  The number of signatures in a model
#' @param x A \code{\linkS4class{result_model}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{musica}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list that contains the desired
#' num_signatures. Used when \code{result} is a \code{\linkS4class{musica}}
#' object.
#' @param modality Modality that contains the desired num_signatures. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier that contains the desired num_signatures.
#' Used when \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @rdname num_signatures
#' @return The number of signatures in a model
#' @export
#' @examples
#' data(res)
#' num_signatures(res, "result", "SBS96", "res")
setGeneric(
  name = "num_signatures",
  def = function(x, ...) {
    standardGeneric("num_signatures")
  }
)

#' @rdname num_signatures
setMethod(
  f = "num_signatures",
  signature = "musica",
  definition = function(x, result, modality, model_id) {
    return(x@result_list[[result]]@modality[[modality]][[model_id]]@
             num_signatures)
  }
)

#' @rdname num_signatures
setMethod(
  f = "num_signatures",
  signature = "result_collection",
  definition = function(x, modality, model_id) {
    return(x@modality[[modality]][[model_id]]@num_signatures)
  }
)

#' @rdname num_signatures
setMethod(
  f = "num_signatures",
  signature = "result_model",
  definition = function(x) {
    return(x@num_signatures)
  }
)

#' @rdname num_signatures
#' @param x A \code{\linkS4class{musica}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{result_model}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list to assign the num_signatures.
#' Used when \code{result} is a \code{\linkS4class{musica}} object.
#' @param modality Modality to assign the num_signatures. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier to assign the num_signatures. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param ... Other inputs
#' @param value Number of signatures in the model
#' @export
setGeneric(
  name = "num_signatures<-",
  def = function(x, ..., value) {
    standardGeneric("num_signatures<-")
  }
)

#' @rdname num_signatures
setReplaceMethod(
  f = "num_signatures",
  signature = c("musica", "matrix"),
  definition = function(x, result, modality, model_id, value) {
    x@result_list[[result]]@modality[[modality]][[model_id]]@num_signatures <-
      value
    return(x)
  }
)

#' @rdname num_signatures
setReplaceMethod(
  f = "num_signatures",
  signature = c("result_collection", "matrix"),
  definition = function(x, modality, model_id, value) {
    x@modality[[modality]][[model_id]]@num_signatures <- value
    return(x)
  }
)

#' @rdname num_signatures
setReplaceMethod(
  f = "num_signatures",
  signature = c("result_model", "matrix"),
  definition = function(x, value) {
    x@num_signatures <- value
    return(x)
  }
)

#' @title Retrieve other_parameters from a result_model, result_collection, or
#' musica object
#' @description  Parameters for the model
#' @param x A \code{\linkS4class{result_model}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{musica}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list that contains the desired
#' other_parameters. Used when \code{result} is a \code{\linkS4class{musica}}
#' object.
#' @param modality Modality that contains the desired other_parameters. Used
#' when \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier that contains the desired other_parameters.
#' Used when \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @rdname other_parameters
#' @return The other parameters for the model
#' @export
#' @examples
#' data(res)
#' other_parameters(res, "result", "SBS96", "res")
setGeneric(
  name = "other_parameters",
  def = function(x, ...) {
    standardGeneric("other_parameters")
  }
)

#' @rdname other_parameters
setMethod(
  f = "other_parameters",
  signature = "musica",
  definition = function(x, result, modality, model_id) {
    return(x@result_list[[result]]@modality[[modality]][[model_id]]@
             other_parameters)
  }
)

#' @rdname other_parameters
setMethod(
  f = "other_parameters",
  signature = "result_collection",
  definition = function(x, modality, model_id) {
    return(x@modality[[modality]][[model_id]]@other_parameters)
  }
)

#' @rdname other_parameters
setMethod(
  f = "other_parameters",
  signature = "result_model",
  definition = function(x) {
    return(x@other_parameters)
  }
)

#' @rdname other_parameters
#' @param x A \code{\linkS4class{musica}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{result_model}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list to assign the other_parameters.
#' Used when \code{result} is a \code{\linkS4class{musica}} object.
#' @param modality Modality to assign the other_parameters. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier to assign the other_parameters. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param ... Other inputs
#' @param value List of other parameters
#' @export
setGeneric(
  name = "other_parameters<-",
  def = function(x, ..., value) {
    standardGeneric("other_parameters<-")
  }
)

#' @rdname other_parameters
setReplaceMethod(
  f = "other_parameters",
  signature = c("musica", "matrix"),
  definition = function(x, result, modality, model_id, value) {
    x@result_list[[result]]@modality[[modality]][[model_id]]@other_parameters <-
      value
    return(x)
  }
)

#' @rdname other_parameters
setReplaceMethod(
  f = "other_parameters",
  signature = c("result_collection", "matrix"),
  definition = function(x, modality, model_id, value) {
    x@modality[[modality]][[model_id]]@other_parameters <- value
    return(x)
  }
)

#' @rdname other_parameters
setReplaceMethod(
  f = "other_parameters",
  signature = c("result_model", "matrix"),
  definition = function(x, value) {
    x@other_parameters <- value
    return(x)
  }
)

#' @title Retrieve credible_intervals from a result_model, result_collection, or
#' musica object
#' @description  Credible intervals for the model
#' @param x A \code{\linkS4class{result_model}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{musica}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list that contains the desired
#' credible_intervals. Used when \code{result} is a \code{\linkS4class{musica}}
#' object.
#' @param modality Modality that contains the desired credible_intervals. Used
#' when \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier that contains the desired
#' credible_intervals.
#' Used when \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @rdname credible_intervals
#' @return The credible intervals for the model
#' @export
#' @examples
#' data(res)
#' credible_intervals(res, "result", "SBS96", "res")
setGeneric(
  name = "credible_intervals",
  def = function(x, ...) {
    standardGeneric("credible_intervals")
  }
)

#' @rdname credible_intervals
setMethod(
  f = "credible_intervals",
  signature = "musica",
  definition = function(x, result, modality, model_id) {
    return(x@result_list[[result]]@modality[[modality]][[model_id]]@
             credible_intervals)
  }
)

#' @rdname credible_intervals
setMethod(
  f = "credible_intervals",
  signature = "result_collection",
  definition = function(x, modality, model_id) {
    return(x@modality[[modality]][[model_id]]@credible_intervals)
  }
)

#' @rdname credible_intervals
setMethod(
  f = "credible_intervals",
  signature = "result_model",
  definition = function(x) {
    return(x@credible_intervals)
  }
)

#' @rdname credible_intervals
#' @param x A \code{\linkS4class{musica}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{result_model}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list to assign the
#' credible_intervals. Used when \code{result} is a \code{\linkS4class{musica}}
#' object.
#' @param modality Modality to assign the credible_intervals. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier to assign the credible_intervals. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param ... Other inputs
#' @param value List of credible intervals
#' @export
setGeneric(
  name = "credible_intervals<-",
  def = function(x, ..., value) {
    standardGeneric("credible_intervals<-")
  }
)

#' @rdname credible_intervals
setReplaceMethod(
  f = "credible_intervals",
  signature = c("musica", "matrix"),
  definition = function(x, result, modality, model_id, value) {
    x@result_list[[result]]@modality[[modality]][[model_id]]@
      credible_intervals <- value
    return(x)
  }
)

#' @rdname credible_intervals
setReplaceMethod(
  f = "credible_intervals",
  signature = c("result_collection", "matrix"),
  definition = function(x, modality, model_id, value) {
    x@modality[[modality]][[model_id]]@credible_intervals <- value
    return(x)
  }
)

#' @rdname credible_intervals
setReplaceMethod(
  f = "credible_intervals",
  signature = c("result_model", "matrix"),
  definition = function(x, value) {
    x@credible_intervals <- value
    return(x)
  }
)

#' @title Retrieve metrics from a result_model, result_collection, or musica
#' object
#' @description Metrics for the model
#' @param x A \code{\linkS4class{result_model}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{musica}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list that contains the desired
#' credible_intervals. Used when \code{result} is a \code{\linkS4class{musica}}
#' object.
#' @param modality Modality that contains the desired metrics. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier that contains the desired metrics. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @rdname metrics
#' @return The metrics for the model
#' @export
#' @examples
#' data(res)
#' metrics(res, "result", "SBS96", "res")
setGeneric(
  name = "metrics",
  def = function(x, ...) {
    standardGeneric("metrics")
  }
)

#' @rdname metrics
setMethod(
  f = "metrics",
  signature = "musica",
  definition = function(x, result, modality, model_id) {
    return(x@result_list[[result]]@modality[[modality]][[model_id]]@metrics)
  }
)

#' @rdname metrics
setMethod(
  f = "metrics",
  signature = "result_collection",
  definition = function(x, modality, model_id) {
    return(x@modality[[modality]][[model_id]]@metrics)
  }
)

#' @rdname metrics
setMethod(
  f = "metrics",
  signature = "result_model",
  definition = function(x) {
    return(x@metrics)
  }
)

#' @rdname metrics
#' @param x A \code{\linkS4class{musica}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{result_model}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list to assign the
#' metrics. Used when \code{result} is a \code{\linkS4class{musica}} object.
#' @param modality Modality to assign the metrics. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier to assign the metrics. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param ... Other inputs
#' @param value List of metrics
#' @export
setGeneric(
  name = "metrics<-",
  def = function(x, ..., value) {
    standardGeneric("metrics<-")
  }
)

#' @rdname metrics
setReplaceMethod(
  f = "metrics",
  signature = c("musica", "SimpleList"),
  definition = function(x, result, modality, model_id, value) {
    x@result_list[[result]]@modality[[modality]][[model_id]]@metrics <- value
    return(x)
  }
)

#' @rdname metrics
setReplaceMethod(
  f = "metrics",
  signature = c("result_collection", "SimpleList"),
  definition = function(x, modality, model_id, value) {
    x@modality[[modality]][[model_id]]@metrics <- value
    return(x)
  }
)

#' @rdname metrics
setReplaceMethod(
  f = "metrics",
  signature = c("result_model", "SimpleList"),
  definition = function(x, value) {
    x@metrics <- value
    return(x)
  }
)

#' @title Retrieve umap list from a result_model, result_collection, or musica
#' object
#' @description The umap dataframes for the model
#' @param x A \code{\linkS4class{result_model}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{musica}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list that contains the desired
#' umap. Used when \code{result} is a \code{\linkS4class{musica}} object.
#' @param modality Modality that contains the desired umap. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier that contains the desired umap. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @rdname umap
#' @return A list of umap dataframes
#' @export
#' @examples
#' data(res)
#' umap(res, "result", "SBS96", "res")
setGeneric(
  name = "umap",
  def = function(x, ...) {
    standardGeneric("umap")
  }
)

#' @rdname umap
setMethod(
  f = "umap",
  signature = "musica",
  definition = function(x, result, modality, model_id) {
    return(x@result_list[[result]]@modality[[modality]][[model_id]]@umap)
  }
)

#' @rdname umap
setMethod(
  f = "umap",
  signature = "result_collection",
  definition = function(x, modality, model_id) {
    return(x@modality[[modality]][[model_id]]@umap)
  }
)

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

#' @rdname umap
#' @param x A \code{\linkS4class{musica}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{result_model}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list to assign the
#' umap. Used when \code{result} is a \code{\linkS4class{musica}} object.
#' @param modality Modality to assign the umap. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier to assign the umap. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param ... Other inputs
#' @param value A list of umap dataframes
#' @export
setGeneric(
  name = "umap<-",
  def = function(x, ..., value) {
    standardGeneric("umap<-")
  }
)

#' @rdname umap
setReplaceMethod(
  f = "umap",
  signature = c("musica", "matrix"),
  definition = function(x, result, modality, model_id, value) {
    x@result_list[[result]]@modality[[modality]][[model_id]]@umap <- value
    return(x)
  }
)

#' @rdname umap
setReplaceMethod(
  f = "umap",
  signature = c("result_collection", "matrix"),
  definition = function(x, modality, model_id, value) {
    x@modality[[modality]][[model_id]]@umap <- value
    return(x)
  }
)

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

#' @title Retrieve model_id from a result_model, result_collection, or musica
#' object
#' @description Model identifier
#' @param x A \code{\linkS4class{result_model}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{musica}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list that contains the desired
#' model_id. Used when \code{result} is a \code{\linkS4class{musica}} object.
#' @param modality Modality that contains the desired model_id. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier that contains the desired model_id. Used
#' when \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @rdname model_id
#' @return The model_id for the model
#' @export
#' @examples
#' data(res)
#' model_id(res, "result", "SBS96", "res")
setGeneric(
  name = "model_id",
  def = function(x, ...) {
    standardGeneric("model_id")
  }
)

#' @rdname model_id
setMethod(
  f = "model_id",
  signature = "musica",
  definition = function(x, result, modality, model_id) {
    return(x@result_list[[result]]@modality[[modality]][[model_id]]@model_id)
  }
)

#' @rdname model_id
setMethod(
  f = "model_id",
  signature = "result_collection",
  definition = function(x, modality, model_id) {
    return(x@modality[[modality]][[model_id]]@model_id)
  }
)

#' @rdname model_id
setMethod(
  f = "model_id",
  signature = "result_model",
  definition = function(x) {
    return(x@model_id)
  }
)

#' @rdname model_id
#' @param x A \code{\linkS4class{musica}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{result_model}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list to assign the
#' model_id. Used when \code{result} is a \code{\linkS4class{musica}} object.
#' @param modality Modality to assign the model_id. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier to assign the model_id. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param ... Other inputs
#' @param value Model identifier
#' @export
setGeneric(
  name = "model_id<-",
  def = function(x, ..., value) {
    standardGeneric("model_id<-")
  }
)

#' @rdname model_id
setReplaceMethod(
  f = "model_id",
  signature = c("musica", "matrix"),
  definition = function(x, result, modality, model_id, value) {
    x@result_list[[result]]@modality[[modality]][[model_id]]@model_id <- value
    return(x)
  }
)

#' @rdname model_id
setReplaceMethod(
  f = "model_id",
  signature = c("result_collection", "matrix"),
  definition = function(x, modality, model_id, value) {
    x@modality[[modality]][[model_id]]@model_id <- value
    return(x)
  }
)

#' @rdname model_id
setReplaceMethod(
  f = "model_id",
  signature = c("result_model", "matrix"),
  definition = function(x, value) {
    x@model_id <- value
    return(x)
  }
)

#' @title Retrieve modality from a result_model, result_collection, or musica
#' object
#' @description The modality
#' @param x A \code{\linkS4class{result_model}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{musica}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list that contains the desired
#' modality. Used when \code{result} is a \code{\linkS4class{musica}} object.
#' @param modality Modality that contains the desired modality. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier that contains the desired modality. Used
#' when \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @rdname modality
#' @return The modality for the model
#' @export
#' @examples
#' data(res)
#' modality(res, "result", "SBS96", "res")
setGeneric(
  name = "modality",
  def = function(x, ...) {
    standardGeneric("modality")
  }
)

#' @rdname modality
setMethod(
  f = "modality",
  signature = "musica",
  definition = function(x, result, modality, model_id) {
    return(x@result_list[[result]]@modality[[modality]][[model_id]]@modality)
  }
)

#' @rdname modality
setMethod(
  f = "modality",
  signature = "result_collection",
  definition = function(x, modality, model_id) {
    return(x@modality[[modality]][[model_id]]@modality)
  }
)

#' @rdname modality
setMethod(
  f = "modality",
  signature = "result_model",
  definition = function(x) {
    return(x@modality)
  }
)

#' @rdname modality
#' @param x A \code{\linkS4class{musica}},
#' \code{\linkS4class{result_collection}}, or \code{\linkS4class{result_model}}
#' object generated by a mutational discovery or prediction tool.
#' @param result Name of result from result_list to assign the
#' modality. Used when \code{result} is a \code{\linkS4class{musica}} object.
#' @param modality Modality to assign the modality. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' \code{\linkS4class{result_collection}} object.
#' @param model_id Model identifier to assign the modality. Used when
#' \code{result} is a \code{\linkS4class{musica}} or
#' @param ... Other inputs
#' \code{\linkS4class{result_collection}} object.
#' @param value A modality
#' @export
setGeneric(
  name = "modality<-",
  def = function(x, ..., value) {
    standardGeneric("modality<-")
  }
)

#' @rdname modality
setReplaceMethod(
  f = "modality",
  signature = c("musica", "matrix"),
  definition = function(x, result, modality, model_id, value) {
    x@result_list[[result]]@modality[[modality]][[model_id]]@modality <- value
    return(x)
  }
)

#' @rdname modality
setReplaceMethod(
  f = "modality",
  signature = c("result_collection", "matrix"),
  definition = function(x, modality, model_id, value) {
    x@modality[[modality]][[model_id]]@modality <- value
    return(x)
  }
)

#' @rdname modality
setReplaceMethod(
  f = "modality",
  signature = c("result_model", "matrix"),
  definition = function(x, value) {
    x@modality <- value
    return(x)
  }
)

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

#' @rdname table_selected
setMethod(
  f = "table_selected",
  signature = "result_model",
  definition = function(result) {
    return(result@modality)
  }
)
campbio/musicatk documentation built on Dec. 25, 2024, 9:34 p.m.