R/AllGenerics.R

#' @include AllClasses.R
NULL

################################################################################
############## getters and setters for ProbMatrixCellTypes class ###############
################################################################################

# prob.matrix

#' @title Get and set \code{prob.matrix} slot in a
#'   \code{\linkS4class{ProbMatrixCellTypes}} object
#'
#' @docType methods
#' @name prob.matrix
#' @rdname prob.matrix
#' @aliases prob.matrix,ProbMatrixCellTypes-method
#' 
#' @param object \code{\linkS4class{ProbMatrixCellTypes}} object.
#'
#' @export prob.matrix
#'   
setGeneric(
  name = "prob.matrix", def = function(object) standardGeneric("prob.matrix")
)
setMethod(
  f = "prob.matrix",
  signature = "ProbMatrixCellTypes",
  definition = function(object) object@prob.matrix
)


#' @docType methods
#' @rdname prob.matrix
#' @aliases prob.matrix<-,ProbMatrixCellTypes-method
#' 
#' @param value Matrix with cell types as columns and samples as
#'   rows.
#'
#' @export prob.matrix<-
#'
setGeneric(
  name = "prob.matrix<-", 
  def = function(object, value) standardGeneric("prob.matrix<-")
)
setMethod(
  f = "prob.matrix<-",
  signature = "ProbMatrixCellTypes",
  definition = function(object, value) {
    object@prob.matrix <- value
    return(object)
  }
)

# cell.names

#' @title Get and set \code{cell.names} slot in a
#'   \code{\linkS4class{ProbMatrixCellTypes}} object
#'
#' @docType methods
#' @name cell.names
#' @rdname cell.names
#' @aliases cell.names,ProbMatrixCellTypes-method
#'
#' @param object \code{\linkS4class{ProbMatrixCellTypes}} object.
#'
#' @export cell.names
#'   
setGeneric(
  name = "cell.names", def = function(object) standardGeneric("cell.names")
)
setMethod(
  f = "cell.names",
  signature = "ProbMatrixCellTypes",
  definition = function(object) object@cell.names
)

#' @docType methods
#' @rdname cell.names
#' @aliases cell.names<-,ProbMatrixCellTypes-method
#'
#' @param value Matrix containing the name of the pseudo-bulk samples to be
#'   simulated as rows and the cells to be used to simulate them as columns
#'   (\code{n.cell} argument)
#'
#' @export cell.names<-
#'   
setGeneric(
  name = "cell.names<-", 
  def = function(object, value) standardGeneric("cell.names<-")
)
setMethod(
  f = "cell.names<-",
  signature = "ProbMatrixCellTypes",
  definition = function(object, value) {
    object@cell.names <- value
    return(object)
  }
)

# set.list

#' @title Get and set \code{set.list} slot in a
#'   \code{\linkS4class{ProbMatrixCellTypes}} object
#'
#' @docType methods
#' @name set.list
#' @rdname set.list
#' @aliases set.list,ProbMatrixCellTypes-method
#' 
#' @param object \code{\linkS4class{ProbMatrixCellTypes}} object.
#'
#' @export set.list
#'   
setGeneric(
  name = "set.list", def = function(object) standardGeneric("set.list")
)
setMethod(
  f = "set.list",
  signature = "ProbMatrixCellTypes",
  definition = function(object) object@set.list
)

#' @docType methods
#' @rdname set.list
#' @aliases set.list<-,ProbMatrixCellTypes-method
#' 
#' @param value List of cells sorted according to the cell type to which they
#'   belong.
#'
#' @export set.list<-
#'   
setGeneric(
  name = "set.list<-", 
  def = function(object, value) standardGeneric("set.list<-")
)
setMethod(
  f = "set.list<-",
  signature = "ProbMatrixCellTypes",
  definition = function(object, value) {
    object@set.list <- value
    return(object)
  }
)

# set

#' @title Get and set \code{set} slot in a
#'   \code{\linkS4class{ProbMatrixCellTypes}} object
#'
#' @docType methods
#' @name set
#' @rdname set
#' @aliases set,ProbMatrixCellTypes-method
#' 
#' @param object \code{\linkS4class{ProbMatrixCellTypes}} object.
#'
#' @export set
#'   
setGeneric(name = "set", def = function(object) standardGeneric("set"))
setMethod(
  f = "set",
  signature = "ProbMatrixCellTypes",
  definition = function(object) object@set
)

#' @docType methods
#' @rdname set
#' @aliases set<-,ProbMatrixCellTypes-method
#' 
#' @param value Vector with names of cells present in the object.
#'
#' @export set<-
#'
setGeneric(
  name = "set<-", def = function(object, value) standardGeneric("set<-")
)
setMethod(
  f = "set<-",
  signature = "ProbMatrixCellTypes",
  definition = function(object, value) {
    object@set <- value
    return(object)
  }
)

# method

#' @title Get and set \code{method} slot in a
#'   \code{\linkS4class{ProbMatrixCellTypes}} object
#'
#' @docType methods
#' @name method
#' @rdname method
#' @aliases method,ProbMatrixCellTypes-method
#' 
#' @param object \code{\linkS4class{ProbMatrixCellTypes}} object.
#'
#' @export method
#'   
setGeneric(name = "method", def = function(object) standardGeneric("method"))
setMethod(
  f = "method",
  signature = "ProbMatrixCellTypes",
  definition = function(object) object@method
)

#' @docType methods
#' @rdname method
#' @aliases method<-,ProbMatrixCellTypes-method
#' 
#' @param value Vector with names of cells present in the object.
#'
#' @export method<-
#'
setGeneric(
  name = "method<-", def = function(object, value) standardGeneric("method<-")
)
setMethod(
  f = "method<-",
  signature = "ProbMatrixCellTypes",
  definition = function(object, value) {
    object@method <- value
    return(object)
  }
)


# plots

#' @title Get and set \code{plots} slot in a
#'   \code{\linkS4class{ProbMatrixCellTypes}} object
#'
#' @docType methods
#' @name plots
#' @rdname plots
#' @aliases plots,ProbMatrixCellTypes-method
#' 
#' @param object \code{\linkS4class{ProbMatrixCellTypes}} object.
#'
#' @export plots
#'   
setGeneric(name = "plots", def = function(object) standardGeneric("plots"))
setMethod(
  f = "plots",
  signature = "ProbMatrixCellTypes",
  definition = function(object) object@plots
)

#' @docType methods
#' @rdname plots
#' @aliases plots<-,ProbMatrixCellTypes-method
#' 
#' @param value List of lists with plots showing the distribution of the cell
#'   proportions generated by each method during the process.
#'
#' @export plots<-
#'
setGeneric(
  name = "plots<-", def = function(object, value) standardGeneric("plots<-")
)
setMethod(
  f = "plots<-",
  signature = "ProbMatrixCellTypes",
  definition = function(object, value) {
    object@plots <- value
    return(object)
  }
)

################################################################################
############## getters and setters for DigitalDLSorterDNN class ################
################################################################################

# model

#' @title Get and set \code{model} slot in a
#'   \code{\linkS4class{DigitalDLSorterDNN}} object
#'
#' @docType methods
#' @name model
#' @rdname model
#' @aliases model,DigitalDLSorterDNN-method
#' 
#' @param object \code{\linkS4class{DigitalDLSorterDNN}} object.
#'
#' @export model
#'   
setGeneric(name = "model", def = function(object) standardGeneric("model"))
setMethod(
  f = "model",
  signature = "DigitalDLSorterDNN",
  definition = function(object) object@model
)

#' @docType methods
#' @rdname model
#' @aliases model<-,DigitalDLSorterDNN-method
#' 
#' @param value \code{keras.engine.sequential.Sequential} object with a
#' trained Deep Neural Network model.
#'
#' @export model<-
#'
setGeneric(
  name = "model<-", def = function(object, value) standardGeneric("model<-")
)
setMethod(
  f = "model<-",
  signature = "DigitalDLSorterDNN",
  definition = function(object, value) {
    object@model <- value
    return(object)
  }
)

# training.history

#' @title Get and set \code{training.history} slot in a
#'   \code{\linkS4class{DigitalDLSorterDNN}} object
#'
#' @docType methods
#' @name training.history
#' @rdname training.history
#' @aliases training.history,DigitalDLSorterDNN-method
#'
#' @param object \code{\linkS4class{DigitalDLSorterDNN}} object.
#'
#' @export training.history
#'
setGeneric(
  name = "training.history", 
  def = function(object) standardGeneric("training.history")
)
setMethod(
  f = "training.history",
  signature = "DigitalDLSorterDNN",
  definition = function(object) object@training.history
)

#' @docType methods
#' @rdname training.history
#' @aliases training.history<-,DigitalDLSorterDNN-method
#'
#' @param value \code{keras_training_history} object with the training history
#'   of the Deep Neural Network model
#'
#' @export training.history<-
#'   
setGeneric(
  name = "training.history<-", 
  def = function(object, value) standardGeneric("training.history<-")
)
setMethod(
  f = "training.history<-",
  signature = "DigitalDLSorterDNN",
  definition = function(object, value) {
    object@training.history <- value
    return(object)
  }
)

# test.metrics

#' @title Get and set \code{test.metrics} slot in a
#'   \code{\linkS4class{DigitalDLSorterDNN}} object
#'
#' @docType methods
#' @name test.metrics
#' @rdname test.metrics
#' @aliases test.metrics,DigitalDLSorterDNN-method
#'
#' @param object \code{\linkS4class{DigitalDLSorterDNN}} object.
#'
#' @export test.metrics
#'
setGeneric(
  name = "test.metrics", def = function(object) standardGeneric("test.metrics")
)
setMethod(
  f = "test.metrics",
  signature = "DigitalDLSorterDNN",
  definition = function(object) object@test.metrics
)

#' @docType methods
#' @rdname test.metrics
#' @aliases test.metrics<-,DigitalDLSorterDNN-method
#' 
#' @param value List object with the resulting metrics after prediction
#'   on test data with the Deep Neural Network model.
#'   
#' @export test.metrics<-
#'   
setGeneric(
  name = "test.metrics<-", 
  def = function(object, value) standardGeneric("test.metrics<-")
)
setMethod(
  f = "test.metrics<-",
  signature = "DigitalDLSorterDNN",
  definition = function(object, value) {
    object@test.metrics <- value
    return(object)
  }
)

# test.pred

#' @title Get and set \code{test.pred} slot in a
#'   \code{\linkS4class{DigitalDLSorterDNN}} object
#'
#' @docType methods
#' @name test.pred
#' @rdname test.pred   
#' @aliases test.pred,DigitalDLSorterDNN-method
#' 
#' @param object \code{\linkS4class{DigitalDLSorterDNN}} object.
#'
#' @export test.pred
#'   
setGeneric(
  name = "test.pred", def = function(object) standardGeneric("test.pred")
)
setMethod(
  f = "test.pred",
  signature = "DigitalDLSorterDNN",
  definition = function(object) object@test.pred
)

#' @docType methods
#' @rdname test.pred
#' @aliases test.pred<-,DigitalDLSorterDNN-method
#' 
#' @param value Matrix object with the prediction results on test data.
#' 
#' @export test.pred<-
#'
setGeneric(
  name = "test.pred<-", 
  def = function(object, value) standardGeneric("test.pred<-")
)
setMethod(
  f = "test.pred<-",
  signature = "DigitalDLSorterDNN",
  definition = function(object, value) {
    object@test.pred <- value
    return(object)
  }
)

# cell.types

#' @title Get and set \code{cell.types} slot in a
#'   \code{\linkS4class{DigitalDLSorterDNN}} object
#'
#' @docType methods
#' @name cell.types
#' @rdname cell.types
#' @aliases cell.types,DigitalDLSorterDNN-method
#'
#' @param object \code{\linkS4class{DigitalDLSorterDNN}} object.
#'
#' @export cell.types
#'   
setGeneric(
  name = "cell.types", def = function(object) standardGeneric("cell.types")
)
setMethod(
  f = "cell.types",
  signature = "DigitalDLSorterDNN",
  definition = function(object) object@cell.types
)

#' @docType methods
#' @rdname cell.types
#' @aliases cell.types<-,DigitalDLSorterDNN-method
#'
#' @param value Vector with cell types considered by the Deep Neural Network
#'   model.
#'
#' @export cell.types<-
#'   
setGeneric(
  name = "cell.types<-", 
  def = function(object, value) standardGeneric("cell.types<-")
)
setMethod(
  f = "cell.types<-",
  signature = "DigitalDLSorterDNN",
  definition = function(object, value) {
    object@cell.types <- value
    return(object)
  }
)

# features

#' @title Get and set \code{features} slot in a
#'   \code{\linkS4class{DigitalDLSorterDNN}} object
#'
#' @docType methods
#' @name features
#' @rdname features
#' @aliases features,DigitalDLSorterDNN-method
#' 
#' @param object \code{\linkS4class{DigitalDLSorterDNN}} object.
#'
#' @export features
#'   
setGeneric(
  name = "features", def = function(object) standardGeneric("features")
)
setMethod(
  f = "features",
  signature = "DigitalDLSorterDNN",
  definition = function(object) object@features
)

#' @docType methods
#' @rdname features
#' @aliases features<-,DigitalDLSorterDNN-method
#'
#' @param value Vector with features (genes) considered by the Deep Neural
#'   Network model.
#'
#' @export features<-
#'   
setGeneric(
  name = "features<-", 
  def = function(object, value) standardGeneric("features<-")
)
setMethod(
  f = "features<-",
  signature = "DigitalDLSorterDNN",
  definition = function(object, value) {
    object@features <- value
    return(object)
  }
)

# test.deconv.metrics

#' @title Get and set \code{test.deconv.metrics} slot in a
#'   \code{\linkS4class{DigitalDLSorterDNN}} object
#'
#' @docType methods
#' @name test.deconv.metrics
#' @rdname test.deconv.metrics
#' @aliases test.deconv.metrics,DigitalDLSorterDNN-method
#' 
#' @param object \code{\linkS4class{DigitalDLSorterDNN}} object.
#' @param metrics Metrics to show (\code{'All'} by default)
#'
#' @export test.deconv.metrics
#'
setGeneric(
  name = "test.deconv.metrics",
  def = function(object, metrics = "All") standardGeneric("test.deconv.metrics")
)
setMethod(
  f = "test.deconv.metrics",
  signature = "DigitalDLSorterDNN",
  definition = function(object, metrics) {
    if (metrics == "All") object@test.deconv.metrics
    else {
      if (!all(metrics %in% names(object@test.deconv.metrics)))
        stop("Metric provided is not present in DigitalDLSorterDNN object")
      return(object@test.deconv.metrics[[metrics]])
    }
  }
)

#' @docType methods
#' @rdname test.deconv.metrics
#' @aliases test.deconv.metrics<-,DigitalDLSorterDNN-method
#' 
#' @param value List with evaluation metrics used to assess the
#'   performance of the model on each sample of test data.
#' @export test.deconv.metrics<-
#'   
setGeneric(
  name = "test.deconv.metrics<-",
  def = function(object, metrics = "All", value) {
    standardGeneric("test.deconv.metrics<-")
  }
)
setMethod(
  f = "test.deconv.metrics<-",
  signature = "DigitalDLSorterDNN",
  definition = function(object, metrics, value) {
    if (metrics == "All") object@test.deconv.metrics <- value
    else {
      if (!all(metrics %in% names(object@test.deconv.metrics)))
        stop("Metric provided is not present in DigitalDLSorterDNN object")
      object@test.deconv.metrics[[metrics]] <- value
    }
    return(object)
  }
)

################################################################################
################ getters and setters for DigitalDLSorter class #################
################################################################################

# single.cell.real

#' @title Get and set \code{single.cell.real} slot in a
#'   \code{\linkS4class{DigitalDLSorter}} object
#'
#' @docType methods
#' @name single.cell.real
#' @rdname single.cell.real
#' @aliases single.cell.real,DigitalDLSorter-method
#' 
#' @param object \code{\linkS4class{DigitalDLSorter}} object.
#'
#' @export single.cell.real
#'   
setGeneric(
  name = "single.cell.real", 
  def = function(object) standardGeneric("single.cell.real")
)
setMethod(
  f = "single.cell.real",
  signature = "DigitalDLSorter",
  definition = function(object) object@single.cell.real
)

#' @docType methods
#' @rdname single.cell.real
#' @aliases single.cell.real<-,DigitalDLSorter-method
#' 
#' @param value \code{\linkS4class{SingleCellExperiment}} object with real
#'   single-cell profiles.
#'   
#' @export single.cell.real<-
#'   
setGeneric(
  name = "single.cell.real<-", 
  def = function(object, value) standardGeneric("single.cell.real<-")
)
setMethod(
  f = "single.cell.real<-",
  signature = "DigitalDLSorter",
  definition = function(object, value) {
    object@single.cell.real <- value
    return(object)
  }
)

# zinb.params

#' @title Get and set \code{zinb.params} slot in a
#'   \code{\linkS4class{DigitalDLSorter}} object
#'
#' @docType methods
#' @name zinb.params
#' @rdname zinb.params
#' @aliases zinb.params,DigitalDLSorter-method
#' 
#' @param object \code{\linkS4class{DigitalDLSorter}} object.
#'
#' @export zinb.params
#'   
setGeneric(
  name = "zinb.params", def = function(object) standardGeneric("zinb.params")
)
setMethod(
  f = "zinb.params",
  signature = "DigitalDLSorter",
  definition = function(object) object@zinb.params
)

#' @docType methods
#' @rdname zinb.params
#' @aliases zinb.params<-,DigitalDLSorter-method
#'
#' @param value \code{\linkS4class{ZinbParametersModel}} object with a valid
#'   \code{\linkS4class{ZinbModel}} object.
#'
#' @export zinb.params<-
#'   
setGeneric(
  name = "zinb.params<-", 
  def = function(object, value) standardGeneric("zinb.params<-")
)
setMethod(
  f = "zinb.params<-",
  signature = "DigitalDLSorter",
  definition = function(object, value) {
    object@zinb.params <- value
    return(object)
  }
)

# single.cell.simul

#' @title Get and set \code{single.cell.simul} slot in a
#'   \code{\linkS4class{DigitalDLSorter}} object
#'
#' @docType methods
#' @name single.cell.simul
#' @rdname single.cell.simul
#' @aliases single.cell.simul,DigitalDLSorter-method
#' 
#' @param object \code{\linkS4class{DigitalDLSorter}} object.
#'
#' @export single.cell.simul
#'   
setGeneric(
  name = "single.cell.simul", 
  def = function(object) standardGeneric("single.cell.simul")
)
setMethod(
  f = "single.cell.simul",
  signature = "DigitalDLSorter",
  definition = function(object) object@single.cell.simul
)

#' @docType methods
#' @rdname single.cell.simul
#' @aliases single.cell.simul<-,DigitalDLSorter-method
#'
#' @param value \code{\linkS4class{SingleCellExperiment}} object with simulated
#'   single-cell profiles.
#'
#' @export single.cell.simul<-
#'   
setGeneric(
  name = "single.cell.simul<-", 
  def = function(object, value) standardGeneric("single.cell.simul<-")
)
setMethod(
  f = "single.cell.simul<-",
  signature = "DigitalDLSorter",
  definition = function(object, value) {
    object@single.cell.simul <- value
    return(object)
  }
)

# prob.cell.types

#' @title Get and set \code{prob.cell.types} slot in a
#'   \code{\linkS4class{DigitalDLSorter}} object
#'
#' @docType methods
#' @name prob.cell.types
#' @rdname prob.cell.types
#' @aliases prob.cell.types,DigitalDLSorter-method
#' 
#' @param object \code{\linkS4class{DigitalDLSorter}} object.
#' @param type.data Element of the list. Can be \code{'train'}, \code{'test'} or
#'   \code{'both'} (the last by default).
#'
#' @export prob.cell.types
#'   
setGeneric(
  name = "prob.cell.types", 
  def = function(object, type.data = "both") standardGeneric("prob.cell.types")
)
setMethod(
  f = "prob.cell.types",
  signature = "DigitalDLSorter",
  definition = function(object, type.data) {
    if (type.data == "train") object@prob.cell.types[["train"]]
    else if (type.data == "test") object@prob.cell.types[["test"]]
    else if (type.data == "both") object@prob.cell.types
    else stop(paste("No", type.data, "in prob.cell.types"))
  }
)

#' @docType methods
#' @rdname prob.cell.types
#' @aliases prob.cell.types<-,DigitalDLSorter-method
#' 
#' @param value List with two elements, train and test, each one with a
#'   \code{\linkS4class{ProbMatrixCellTypes}} object.
#'   
#' @export prob.cell.types<-
#'   
setGeneric(
  name = "prob.cell.types<-", 
  def = function(object, type.data = "both", value) {
    standardGeneric("prob.cell.types<-")
  }
)
setMethod(
  f = "prob.cell.types<-",
  signature = "DigitalDLSorter",
  definition = function(object, type.data, value) {
    if (type.data == "train") object@prob.cell.types[["train"]] <- value
    else if (type.data == "test") object@prob.cell.types[["test"]] <- value
    else if (type.data == "both") object@prob.cell.types <- value
    else stop(paste("No", type.data, "in prob.cell.types slot"))
    return(object)
  }
)

# bulk.simul

#' Get and set \code{bulk.simul} slot in a
#'   \code{\linkS4class{DigitalDLSorter}} object
#'
#' @docType methods
#' @name bulk.simul
#' @rdname bulk.simul
#' @aliases bulk.simul,DigitalDLSorter-method
#' 
#' @param object \code{\linkS4class{DigitalDLSorter}} object.
#' @param type.data Element of the list. Can be \code{'train'}, \code{'test'} or
#'   \code{'both'} (the last by default).
#'
#' @export bulk.simul
#'   
setGeneric(
  name = "bulk.simul", 
  def = function(object, type.data = "both") standardGeneric("bulk.simul")
)
setMethod(
  f = "bulk.simul",
  signature = "DigitalDLSorter",
  definition = function(object, type.data) {
    if (type.data == "train") object@bulk.simul[["train"]]
    else if (type.data == "test") object@bulk.simul[["test"]]
    else if (type.data == "both") object@bulk.simul
    else stop(paste("No", type.data, "in bulk.simul slot"))
  }
)

#' @docType methods
#' @rdname bulk.simul
#' @aliases bulk.simul<-,DigitalDLSorter-method
#' 
#' @param value List with two elements, train and test, each one being
#'   a \code{\linkS4class{SummarizedExperiment}} object with simulated bulk
#'   RNA-Seq samples.
#'
#' @export bulk.simul<-
#'   
setGeneric(
  name = "bulk.simul<-", 
  def = function(object, type.data = "both", value) {
    standardGeneric("bulk.simul<-")
  }
)
setMethod(
  f = "bulk.simul<-",
  signature = "DigitalDLSorter",
  definition = function(object, type.data, value) {
    if (type.data == "train") object@bulk.simul[["train"]] <- value
    else if (type.data == "test") object@bulk.simul[["test"]] <- value
    else if (type.data == "both") object@bulk.simul <- value
    else stop(paste("No", type.data, "in bulk.simul slot"))
    return(object)
  }
)

# trained.model

#' @title Get and set \code{trained.model} slot in a
#'   \code{\linkS4class{DigitalDLSorter}} object
#'
#' @docType methods
#' @name trained.model
#' @rdname trained.model
#' @aliases trained.model,DigitalDLSorter-method
#'
#' @param object \code{\linkS4class{DigitalDLSorter}} object.
#'
#' @export trained.model
#'   
setGeneric(
  name = "trained.model", 
  def = function(object) standardGeneric("trained.model")
)
setMethod(
  f = "trained.model",
  signature = "DigitalDLSorter",
  definition = function(object) object@trained.model
)

#' @docType methods
#' @rdname trained.model
#' @aliases trained.model<-,DigitalDLSorter-method
#' 
#' @param value \code{\linkS4class{DigitalDLSorterDNN}} object.
#' 
#' @export trained.model<-
#'
setGeneric(
  name = "trained.model<-", 
  def = function(object, value) standardGeneric("trained.model<-")
)
setMethod(
  f = "trained.model<-",
  signature = "DigitalDLSorter",
  definition = function(object, value) {
    object@trained.model <- value
    return(object)
  }
)

# deconv.data

#' @title Get and set \code{deconv.data} slot in a
#'   \code{\linkS4class{DigitalDLSorter}} object
#'
#' @docType methods
#' @name deconv.data
#' @rdname deconv.data
#' @aliases deconv.data,DigitalDLSorter-method
#' 
#' @param object \code{\linkS4class{DigitalDLSorter}} object.
#' @param name.data Name of the data. If \code{NULL} (by default), all
#'   data contained in the \code{deconv.data} slot are returned.
#'
#' @export deconv.data
#'   
setGeneric(
  name = "deconv.data", 
  def = function(object, name.data = NULL) standardGeneric("deconv.data")
)
setMethod(
  f = "deconv.data",
  signature = "DigitalDLSorter",
  definition = function(object, name.data) {
    if (is.null(name.data)) object@deconv.data
    else {
      if (!name.data %in% names(object@deconv.data)) {
        stop("'name.data' provided does not exists in deconv.data slot")
      }
      return(object@deconv.data[[name.data]])
    }
  }
)

#' @docType methods
#' @rdname deconv.data
#' @aliases deconv.data<-,DigitalDLSorter-method
#' 
#' @param value List whose names are the reference of the stored data.
#' 
#' @export deconv.data<-
#'
setGeneric(
  name = "deconv.data<-", 
  def = function(object, name.data = NULL, value) {
    standardGeneric("deconv.data<-")
  }
)
setMethod(
  f = "deconv.data<-",
  signature = "DigitalDLSorter",
  definition = function(object, name.data, value) {
    if (is.null(name.data)) object@deconv.data <- value
    else {
      if (!name.data %in% names(object@deconv.data)) {
        warning(
          "'name.data' provided already exists in deconv.data slot. ", 
          "It will be overwritten"
        )
      }
      object@deconv.data[[name.data]] <- value
    }
    return(object)
  }
)

# deconv.results

#' @title Get and set \code{deconv.results} slot in a
#'   \code{\linkS4class{DigitalDLSorter}} object
#'
#' @docType methods
#' @name deconv.results
#' @rdname deconv.results
#' @aliases deconv.results,DigitalDLSorter-method
#' 
#' @param object \code{\linkS4class{DigitalDLSorter}} object.
#' @param name.data Name of the data. If \code{NULL} (by default), all
#'   results contained in the \code{deconv.results} slot are returned.
#'
#' @export deconv.results
#'   
setGeneric(
  name = "deconv.results", 
  def = function(object, name.data = NULL) standardGeneric("deconv.results")
)
setMethod(
  f = "deconv.results",
  signature = "DigitalDLSorter",
  definition = function(object, name.data) {
    if (is.null(name.data)) object@deconv.results
    else {
      if (!name.data %in% names(object@deconv.results)) {
        stop("'name.data' provided does not exists in deconv.results slot")
      }
      return(object@deconv.results[[name.data]])
    }
  }
)

#' @docType methods
#' @rdname deconv.results
#' @aliases deconv.results<-,DigitalDLSorter-method
#'
#' @param value List whose names are the reference of the stored results.
#'
#' @export deconv.results<-
#'   
setGeneric(
  name = "deconv.results<-", 
  def = function(object, name.data = NULL, value) {
    standardGeneric("deconv.results<-")
  }
)
setMethod(
  f = "deconv.results<-",
  signature = "DigitalDLSorter",
  definition = function(object, name.data, value) {
    if (is.null(name.data)) {
      object@deconv.results <- value  
    } else {
      object@deconv.results[[name.data]] <- value
    }
    return(object)
  }
)

# project

#' @title Get and set \code{project} slot in a
#'   \code{\linkS4class{DigitalDLSorter}} object
#'
#' @docType methods
#' @name project
#' @rdname project
#' @aliases project,DigitalDLSorter-method
#' 
#' @param object \code{\linkS4class{DigitalDLSorter}} object.
#'
#' @export project
#'   
setGeneric(
  name = "project", def = function(object) standardGeneric("project")
)
setMethod(
  f = "project",
  signature = "DigitalDLSorter",
  definition = function(object) object@project
)

#' @docType methods
#' @rdname project
#' @aliases project<-,DigitalDLSorter-method
#' 
#' @param value Character indicating the name of the project.
#' 
#' @export project<-
#'
setGeneric(
  name = "project<-", def = function(object, value) standardGeneric("project<-")
)
setMethod(
  f = "project<-",
  signature = "DigitalDLSorter",
  definition = function(object, value) {
    object@project <- value
    return(object)
  }
)

################################################################################
############## getters and setters for ZinbParametersModel class ###############
################################################################################

# zinbwave.model

#' @title Get and set \code{zinbwave.model} slot in a
#'   \code{\linkS4class{ZinbParametersModel}} object
#'
#' @docType methods
#' @name zinbwave.model
#' @rdname zinbwave.model
#' @aliases zinbwave.model,ZinbParametersModel-method
#' 
#' @param object \code{\linkS4class{ZinbParametersModel}} object.
#'
#' @export zinbwave.model
#'   
setGeneric(
  name = "zinbwave.model", 
  def = function(object) standardGeneric("zinbwave.model")
)
setMethod(
  f = "zinbwave.model",
  signature = "ZinbParametersModel",
  definition = function(object) object@zinbwave.model
)

#' @docType methods
#' @rdname zinbwave.model
#' @aliases zinbwave.model<-,ZinbParametersModel-method
#'
#' @param value \code{\linkS4class{ZinbModel}} object with the estimated
#'   parameters.
#'
#' @export zinbwave.model<-
#'   
setGeneric(
  name = "zinbwave.model<-", 
  def = function(object, value) standardGeneric("zinbwave.model<-")
)
setMethod(
  f = "zinbwave.model<-",
  signature = "ZinbParametersModel",
  definition = function(object, value) {
    object@zinbwave.model <- value
    return(object)
  }
)


#' Save \code{\linkS4class{DigitalDLSorter}} objects as RDS files
#'
#' Save \code{\linkS4class{DigitalDLSorter}} and
#' \code{\linkS4class{DigitalDLSorterDNN}} objects as RDS files. \pkg{keras}
#' models cannot be stored natively as R objects (e.g. RData or RDS files). By
#' saving the structure as a JSON-like character object and the weights as a
#' list, it is possible to retrieve the model and make predictions. If the
#' \code{trained.model} slot is empty, the function will behave as usual.
#' \strong{Note:} with this option, the state of optimizer is not saved, only
#' the architecture and weights. It is possible to save the entire model as an
#' HDF5 file with the \code{\link{saveTrainedModelAsH5}} function and to load it
#' into a \code{\linkS4class{DigitalDLSorter}} object with the
#' \code{\link{loadTrainedModelFromH5}} function. See documentation for details.
#'
#' @docType methods
#' @name saveRDS
#' @rdname saveRDS
#' @aliases saveRDS,saveRDS-method
#'
#' @param object \code{\linkS4class{DigitalDLSorter}} or
#'   \code{\linkS4class{DigitalDLSorterDNN}} object to be saved
#' @param file File path where the object will be saved
#' @inheritParams base::saveRDS
#'
#' @return No return value, saves a \code{\linkS4class{DigitalDLSorter}} object
#'   as an RDS file on disk.
#'
#' @export
#'
#' @seealso \code{\linkS4class{DigitalDLSorter}}
#'   \code{\link{saveTrainedModelAsH5}}
#'   
setGeneric(
  name = "saveRDS", 
  def = function(
    object,
    file,
    ascii = FALSE,
    version = NULL,
    compress = TRUE,
    refhook = NULL
  ) {
    standardGeneric("saveRDS")
  }
)

#' @export
#'
#' @rdname saveRDS
setMethod(
  f = "saveRDS", 
  signature = "DigitalDLSorterDNN", 
  definition = function(
    object,
    file,
    ascii,
    version,
    compress,
    refhook
  ) {
    if ("keras.engine.sequential.Sequential" %in% class(model(object))) {
      object <- .saveModelToJSON(object)
      base::saveRDS(
        object = object,
        file = file,
        ascii = ascii,
        version = version,
        compress = compress,
        refhook = refhook
      )
    } else if (is(model(object), "list")) {
      base::saveRDS(
        object = object,
        file = file,
        ascii = ascii,
        version = version,
        compress = compress,
        refhook = refhook
      )
    } else {
      stop("No valid DigitalDLSorterDNN object")
    }
  }
)

#' @export
#'
#' @rdname saveRDS
setMethod(
  f = "saveRDS", 
  signature = "DigitalDLSorter", 
  definition = function(
    object,
    file,
    ascii,
    version,
    compress,
    refhook
  ) {
    if (!is.null(trained.model(object))) {
      if ("keras.engine.sequential.Sequential" %in% 
          class(trained.model(object)@model)) {
        model.object <- .saveModelToJSON(trained.model(object))
        trained.model(object) <- model.object
      }
    }
    base::saveRDS(
      object = object,
      file = file,
      ascii = ascii,
      version = version,
      compress = compress,
      refhook = refhook
    )
  }
)

#' Bar plot of deconvoluted cell type proportions in bulk RNA-Seq samples
#'
#' Bar plot of deconvoluted cell type proportions in bulk RNA-Seq samples.
#'
#' @param data \code{\linkS4class{DigitalDLSorter}} object with
#'   \code{deconv.results} slot or a data frame/matrix with cell types as
#'   columns and samples as rows.
#' @param colors Vector of colors to be used.
#' @param simplify Type of simplification performed during deconvolution. Can be
#'   \code{simpli.set} or \code{simpli.maj} (\code{NULL} by default). It is only
#'   for \code{\linkS4class{DigitalDLSorter}} objects.
#' @param color.line Color of the border bars.
#' @param x.label Label of x-axis.
#' @param rm.x.text Logical value indicating whether to remove x-axis ticks
#'   (name of samples).
#' @param title Title of the plot.
#' @param legend.title Title of the legend plot.
#' @param angle Angle of text ticks.
#' @param name.data If a \code{\linkS4class{DigitalDLSorter}} is given, name of
#'   the element that stores the results in the \code{deconv.results} slot.
#' @param theme \pkg{ggplot2} theme.
#' @param ... Other arguments for specific methods.
#'
#' @return A ggplot object with the provided cell proportions represented as a
#'   bar plot.
#'
#' @export
#'
#' @examples
#' # matrix of simulated proportions (same estructure as deconvolution results)
#' deconvResults <- gtools::rdirichlet(n = 20, alpha = c(1, 1, 1, 0.5, 0.1))
#' colnames(deconvResults) <- paste("CellType", seq(ncol(deconvResults)))
#' rownames(deconvResults) <- paste("BulkSample", seq(nrow(deconvResults)))
#' barPlotCellTypes(deconvResults)
#'
#' # Using a DigitalDLSorter object
#' DDLS <- DigitalDLSorter(deconv.results = list(Example = deconvResults))
#' barPlotCellTypes(DDLS)
#' 
#' @rdname barPlotCellTypes
#'
#' @seealso \code{\link{deconvDigitalDLSorter}}
#'   \code{\link{deconvDigitalDLSorterObj}}
#'   
setGeneric(
  name = "barPlotCellTypes", 
  def = function(
    data,
    colors = NULL,
    simplify = NULL,
    color.line = NA,
    x.label = "Bulk samples",
    rm.x.text = FALSE,
    title = "Results of deconvolution",
    legend.title = "Cell types",
    angle = 90,
    theme = NULL, 
    ...
  ) {
    standardGeneric("barPlotCellTypes")
  }
)

#' @export
#'
#' @rdname barPlotCellTypes
setMethod(
  f = "barPlotCellTypes",
  signature = signature(data = "DigitalDLSorter"),
  definition = function(
    data,
    colors = NULL,
    simplify = NULL,
    color.line = NA,
    x.label = "Bulk samples",
    rm.x.text = FALSE,
    title = "Results of deconvolution",
    legend.title = "Cell types",
    angle = 90,
    theme = NULL,
    name.data = NULL
  ) {
    if (is.null(deconv.results(data))) {
      stop("There are no results in DigitalDLSorter object. Please see ?deconvDigitalDLSorterObj")
    } else if (is.null(name.data)) {
      message("'name.data' not provided. By default, first results are used")
      name.data <- 1
    } else if (!any(name.data %in% names(deconv.results(data))) &&
               !any(name.data %in% seq_along(deconv.results(data)))) {
      stop("Provided 'name.data' does not exist")
    }
    if (!is.null(simplify) && !is.na(simplify)) {
      if (!is(deconv.results(data)[[name.data]], "list")) {
        stop("No simplified results available")
      } else {
        if (simplify != "simpli.set" && simplify != "simpli.majority") {
          stop("simplify argument must be one of the following options: ",
               "'simpli.set' or 'simpli.majority'")
        } else if (!any(simplify == names(deconv.results(data)[[name.data]]))) {
          stop(paste(simplify, "data is not present in DigitalDLSorter object"))
        }
        res <- deconv.results(data)[[name.data]][[simplify]]
      }
    } else {
      if (is(deconv.results(data)[[name.data]], "list")) {
        res <- deconv.results(data)[[name.data]][[1]]
      } else {
        res <- deconv.results(data)[[name.data]]
      }
    }
    if (is.null(colnames(res))) {
      stop("'data' must have colnames (corresponding cell types). Please run deconvDigitalDLSorterObj")
    }
    return(
      .barPlot(
        data = res,
        colors = colors,
        color.line = color.line,
        x.label = x.label,
        rm.x.text = rm.x.text,
        title = title,
        legend.title = legend.title,
        angle = angle,
        theme = theme
      )
    )
  }
)

#' @export
#'
#' @rdname barPlotCellTypes
setMethod(
  f = "barPlotCellTypes", 
  signature = signature(data = "ANY"),
  definition = function(
    data,
    colors,
    color.line = NA,
    x.label = "Bulk samples",
    rm.x.text = FALSE,
    title = "Results of deconvolution",
    legend.title = "Cell types",
    angle = 90,
    theme = NULL
  ) {
    if (is.null(colnames(data))) {
      stop("'data' must have colnames (corresponding cell types). Please run deconvDigitalDLSorter")
    }
    plot <- .barPlot(
      data = data,
      colors = colors,
      color.line = color.line,
      x.label = x.label,
      rm.x.text = rm.x.text,
      title = title,
      legend.title = legend.title,
      angle = angle,
      theme = theme
    )
    return(plot)
  }
)


#' Load data to be deconvoluted into a DigitalDLSorter object
#'
#' Load data to be deconvoluted. Data can be provided from a file path of a
#' tabulated text file (tsv and tsv.gz formats are accepted) or a
#' \code{\linkS4class{SummarizedExperiment}} object.
#'
#' @param object \code{\linkS4class{DigitalDLSorter}} object with
#'   \code{trained.model} slot.
#' @param data File path where the data is stored or a
#'   \code{\linkS4class{SummarizedExperiment}} object.
#' @param name.data Name under which the data is stored in the
#'   \code{\linkS4class{DigitalDLSorter}} object. When \code{data} is a file
#'   path and \code{name.data} is not provided, the base name of file will be
#'   used.
#'
#' @return A \code{\linkS4class{DigitalDLSorter}} object with \code{deconv.data}
#'   slot with the new bulk-RNA-Seq samples loaded.
#'
#' @export
#'
#' @seealso \code{\link{trainDigitalDLSorterModel}}
#'   \code{\link{deconvDigitalDLSorterObj}}
#'   
setGeneric("loadDeconvData", function(
  object,
  data,
  name.data = NULL
) {
  standardGeneric("loadDeconvData")
})

#' @export
#'
#' @rdname loadDeconvData
setMethod(
  f = "loadDeconvData",
  signature = signature(object = "DigitalDLSorter", data = "character"),
  definition = function(
    object,
    data,
    name.data = NULL
  ) {
    if (!is(object, "DigitalDLSorter")) {
      stop("Provided object is not of DigitalDLSorter class")
    }
    counts <- .readTabFiles(file = data)
    if (is.null(rownames(counts)) || is.null(colnames(counts))) {
      stop("New data must have genes as rows and samples as columns")
    }
    se.object <- SummarizedExperiment::SummarizedExperiment(
      assays = list(counts = counts),
      rowData = data.frame(rownames(counts)),
      colData = data.frame(colnames(counts)),
    )
    # generate name for data if is not provided
    if (is.null(name.data)) {
      name.data <- tools::file_path_sans_ext(basename(data))
    }
    # create or not a new list
    if (is.null(object@deconv.data)) list.data <- list()
    else list.data <- object@deconv.data
    # check if name.data exists
    if (name.data %in% names(list.data)) {
      stop(paste(name.data, "data already exists in 'deconv.data' slot"))
    }
    list.data[[name.data]] <- se.object
    object@deconv.data <- list.data
    return(object)
  }
)

#' @export
#'
#' @rdname loadDeconvData
setMethod(
  f = "loadDeconvData",
  signature = signature(object = "DigitalDLSorter", 
                        data = "SummarizedExperiment"),
  definition = function(
    object,
    data,
    name.data = NULL
  ) {
    if (!is(object, "DigitalDLSorter")) {
      stop("The provided object is not of DigitalDLSorter class")
    } else if (!is(data, "SummarizedExperiment")) {
      stop("The provided object is not of SummarizedExperiment class")
    }
    if (length(assays(data)) == 0) {
      stop("assay slot of SummarizedExperiment object is empty")
    } else if (length(assays(data)) > 1) {
      warning(paste("There are more than one assays in SummarizedExperiment object,",
                    "only the first assay will be considered. Remember that it is", "
                  recommended that the provided data be of the same nature as",
                  "the data with which the model has been trained (e.g. TPMs)"))
    }
    # generate name for data if is not provided
    if (is.null(name.data)) {
      if (is.null(deconv.data(object))) {
        name.data <- "deconv_1"
      } else {
        name.data <- paste0("decon_", length(deconv.data(object)) + 1)
      }
    }
    # create or not a new list
    if (is.null(deconv.data(object))) list.data <- list()
    else list.data <- deconv.data(object)
    # check if name.data exists
    if (name.data %in% names(list.data)) {
      stop(paste(name.data, "data already exists in deconv.data slot"))
    }
    list.data[[name.data]] <- data
    deconv.data(object) <- list.data
    return(object)
  }
)

Try the digitalDLSorteR package in your browser

Any scripts or data that you put into this service are public.

digitalDLSorteR documentation built on Oct. 5, 2022, 9:05 a.m.