Add ZINBParams

DESCRIPTION

@@ -53,7 +53,8 @@ Suggests:
     scDD,
     scran,
     mfa,
-    phenopath
+    phenopath,
+    zinbwave
 biocViews: SingleCell, RNASeq, Transcriptomics, GeneExpression, Sequencing,
     Software
 URL: https://github.com/Oshlack/splatter

NAMESPACE

@@ -37,6 +37,7 @@ export(newPhenoParams)
 export(newSCDDParams)
 export(newSimpleParams)
 export(newSplatParams)
+export(newZINBParams)
 export(phenoEstimate)
 export(phenoSimulate)
 export(scDDEstimate)
@@ -58,6 +59,7 @@ exportClasses(PhenoParams)
 exportClasses(SCDDParams)
 exportClasses(SimpleParams)
 exportClasses(SplatParams)
+exportClasses(ZINBParams)
 importFrom(BiocParallel,SerialParam)
 importFrom(BiocParallel,bplapply)
 importFrom(SingleCellExperiment,"cpm<-")

R/AllClasses.R

@@ -540,3 +540,36 @@ setClass("PhenoParams",
                    n.de.pst.beta = "numeric"),
          prototype = prototype(n.de = 2500, n.pst = 2500, n.pst.beta = 2500,
                                n.de.pst.beta = 2500))
+
+
+#' The ZINBParams class
+#'
+#' S4 class that holds parameters for the ZINB-WaVE simulation.
+#'
+#' @section Parameters:
+#'
+#' The ZINB-WaVE simulation uses the following parameters:
+#'
+#' \describe{
+#'     \item{\code{nGenes}}{The number of genes to simulate.}
+#'     \item{\code{nCells}}{The number of cells to simulate.}
+#'     \item{\code{[seed]}}{Seed to use for generating random numbers.}
+#'     \item{\code{model}}{Object describing a ZINB model.}
+#' }
+#'
+#' The majority of the parameters for this simulation are stored in a
+#' \code{\link[zinbwave]{ZinbModel}} object. Please refer to the documentation
+#' for this class for details about all the parameters.
+#'
+#' The parameters not shown in brackets can be estimated from real data using
+#' \code{\link{zinbEstimate}}. For details of the ZINB-WaVE simulation
+#' see \code{\link{zinbSimulate}}.
+#'
+#' @name ZINBParams
+#' @rdname ZINBParams
+#' @aliases ZINBParams-class
+#' @exportClass ZINBParams
+setClass("ZINBParams",
+         contains = "Params",
+         slots = c(model = "ZinbModel"),
+         prototype = prototype(model = zinbwave::zinbModel()))

R/ZINBParams-methods.R

+#' @rdname newParams
+#' @importFrom methods new
+#' @export
+newZINBParams <- function(...) {
+
+    if (!requireNamespace("zinbwave", quietly = TRUE)) {
+        stop("The ZINB-WaVE simulation requires the 'zinbwave' package.")
+    }
+
+    params <- new("ZINBParams")
+
+    params <- setParams(params, ...)
+
+    return(params)
+}
+
+setValidity("ZINBParams", function(object) {
+
+    v <- getParams(object, slotNames(object))
+
+    checks <- c(nGenes = checkmate::checkInt(v$nGenes, lower = 1),
+                nCells = checkmate::checkInt(v$nCells, lower = 1),
+                seed = checkmate::checkInt(v$seed, lower = 0),
+                model = checkmate::checkClass(v$model, "ZinbModel"),
+                model_valid = validObject(v$model, test = TRUE))
+
+    if (all(checks == TRUE)) {
+        valid <- TRUE
+    } else {
+        valid <- checks[checks != TRUE]
+        valid <- paste(names(valid), valid, sep = ": ")
+    }
+
+    return(valid)
+})
+
+#' @rdname setParam
+setMethod("setParam", "ZINBParams", function(object, name, value) {
+    checkmate::assertString(name)
+
+    if (name %in% names(getSlots("ZinbModel"))) {
+        model <- getParam(object, "model")
+        slot(model, name) <- value
+        object <- setParam(object, "model", model)
+    } else {
+        object <- callNextMethod()
+    }
+
+    return(object)
+})
+
+setMethod("show", "ZINBParams", function(object) {
+
+    pp <- list("Design:"         = c("(Samples)"       = "X",
+                                     "(Genes)"         = "V"),
+               "Offsets:"        = c("(Mu)"            = "O_mu",
+                                     "(Pi)"            = "O_pi"),
+               "Indices:"        = c("(Sample Mu)"     = "which_X_mu",
+                                     "(Gene Mu)"       = "which_V_mu",
+                                     "(Sample Pi)"     = "which_X_pi",
+                                     "(Gene Pi)"       = "which_V_pi"),
+               "Intercepts:"     = c("(Sample Mu)"     = "X_mu_intercept",
+                                     "(Gene Mu)"       = "V_mu_intercept",
+                                     "(Sample Pi)"     = "X_pi_intercept",
+                                     "(Gene Pi)"       = "V_pi_intercept"),
+               "Latent factors:" = c("(W)"             = "W"),
+               "Coefficients:"   = c("(Sample Mu)"     = "beta_mu",
+                                     "(Gene Mu)"       = "gamma_mu",
+                                     "(Latent Mu)"     = "alpha_mu",
+                                     "(Sample Pi)"     = "beta_pi",
+                                     "(Gene Pi)"       = "gamma_pi",
+                                     "(Latent Pi)"     = "alpha_pi"),
+               "Regularisation:" = c("(Sample Mu)"     = "epsilon_beta_mu",
+                                     "(Gene Mu)"       = "epsilon_gamma_mu",
+                                     "(Sample Pi)"     = "epsilon_beta_pi",
+                                     "(Gene Pi)"       = "epsilon_gamma_pi",
+                                     "(Latent)"        = "epsilon_W",
+                                     "(Latent coeffs)" = "epsilon_alpha",
+                                     "(Zeta)"          = "epsilon_zeta",
+                                     "(Logit)"         = "epsilon_min_logit"))
+
+    callNextMethod()
+
+    model <- getParam(object, "model")
+    cat("Model:", "\n")
+    cat("ZinbModel with", zinbwave::nFeatures(model), "features,",
+        zinbwave::nSamples(model), "samples,", zinbwave::nFactors(model),
+        "factors and", zinbwave::nParams(model), "parameters", "\n\n")
+
+    default <- zinbwave::zinbModel()
+    for (category in names(pp)) {
+        parameters <- pp[[category]]
+        values <- lapply(parameters, function(x) {slot(model, x)})
+        short.values <- sapply(values, function(x) {
+            if ("matrix" %in% class(x)) {
+                if (nrow(x) == 1) {
+                    paste0(paste(head(x[1, ], n = 4), collapse = ", "), ",...")
+                } else if (ncol(x) == 1) {
+                    paste0(paste(head(x[, 1], n = 4), collapse = ", "), ",...")
+                } else {
+                    paste(nrow(x), "x", ncol(x), "matrix")
+                }
+            } else if (length(x) > 4) {
+                paste0(paste(head(x, n = 4), collapse = ", "), ",...")
+            } else {
+                paste(x, collapse = ", ")
+            }
+        })
+        values <- sapply(values, paste, collapse = ", ")
+        default.values <- lapply(parameters, function(x) {slot(default, x)})
+        default.values <- sapply(default.values, paste, collapse = ", ")
+        not.default <- values != default.values
+        names(short.values)[not.default] <- toupper(names(values[not.default]))
+        cat("Model", category, "\n")
+        print(noquote(short.values), print.gap = 2)
+        cat("\n")
+    }
+
+})

man/ZINBParams.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/AllClasses.R
+\docType{class}
+\name{ZINBParams}
+\alias{ZINBParams}
+\alias{ZINBParams-class}
+\title{The ZINBParams class}
+\description{
+S4 class that holds parameters for the ZINB-WaVE simulation.
+}
+\section{Parameters}{
+
+
+The ZINB-WaVE simulation uses the following parameters:
+
+\describe{
+    \item{\code{nGenes}}{The number of genes to simulate.}
+    \item{\code{nCells}}{The number of cells to simulate.}
+    \item{\code{[seed]}}{Seed to use for generating random numbers.}
+    \item{\code{model}}{Object describing a ZINB model.}
+}
+
+The majority of the parameters for this simulation are stored in a
+\code{\link[zinbwave]{ZinbModel}} object. Please refer to the documentation
+for this class for details about all the parameters.
+
+The parameters not shown in brackets can be estimated from real data using
+\code{\link{zinbEstimate}}. For details of the ZINB-WaVE simulation
+see \code{\link{zinbSimulate}}.
+}
+

man/newParams.Rd

 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/AllGenerics.R, R/Lun2Params-methods.R,
 %   R/LunParams-methods.R, R/MFAParams-methods.R, R/PhenoParams-methods.R,
-%   R/SCDDParams-methods.R, R/SimpleParams-methods.R, R/SplatParams-methods.R
+%   R/SCDDParams-methods.R, R/SimpleParams-methods.R, R/SplatParams-methods.R,
+%   R/ZINBParams-methods.R
 \name{newParams}
 \alias{newParams}
 \alias{newLun2Params}
@@ -11,6 +12,7 @@
 \alias{newSCDDParams}
 \alias{newSimpleParams}
 \alias{newSplatParams}
+\alias{newZINBParams}
 \title{New Params}
 \usage{
 newLun2Params(...)
@@ -26,6 +28,8 @@ newSCDDParams(...)
 newSimpleParams(...)
 
 newSplatParams(...)
+
+newZINBParams(...)
 }
 \arguments{
 \item{...}{additional parameters passed to \code{\link{setParams}}.}

man/setParam.Rd

 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/AllGenerics.R, R/Lun2Params-methods.R,
 %   R/LunParams-methods.R, R/Params-methods.R, R/PhenoParams-methods.R,
-%   R/SCDDParams-methods.R, R/SplatParams-methods.R
+%   R/SCDDParams-methods.R, R/SplatParams-methods.R, R/ZINBParams-methods.R
 \docType{methods}
 \name{setParam}
 \alias{setParam}
@@ -11,6 +11,7 @@
 \alias{setParam,PhenoParams-method}
 \alias{setParam,SCDDParams-method}
 \alias{setParam,SplatParams-method}
+\alias{setParam,ZINBParams-method}
 \title{Set a parameter}
 \usage{
 setParam(object, name, value)
@@ -26,6 +27,8 @@ setParam(object, name, value)
 \S4method{setParam}{SCDDParams}(object, name, value)
 
 \S4method{setParam}{SplatParams}(object, name, value)
+
+\S4method{setParam}{ZINBParams}(object, name, value)
 }
 \arguments{
 \item{object}{object to set parameter in.}