Add PhenoParams

DESCRIPTION

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

R/AllClasses.R

@@ -500,3 +500,43 @@ setClass("MFAParams",
                    dropout.lambda = "numeric"),
          prototype = prototype(trans.prop = 0, zero.neg = TRUE,
                                dropout.present = FALSE, dropout.lambda = 1))
+
+
+#' The PhenoParams class
+#'
+#' S4 class that holds parameters for the PhenoPath simulation.
+#'
+#' @section Parameters:
+#'
+#' The PhenoPath 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{[n.de]}}{Number of genes to simulate from the differential
+#'     expression regime}
+#'     \item{\code{[n.pst]}}{Number of genes to simulate from the pseudotime
+#'     regime}
+#'     \item{\code{[n.pst.beta]}}{Number of genes to simulate from the
+#'     pseudotime + beta interactions regime}
+#'     \item{\code{[n.de.pst.beta]}}{Number of genes to simulate from the
+#'     differential expression + pseudotime + interactions regime}
+#' }
+#'
+#' The parameters not shown in brackets can be estimated from real data using
+#' \code{\link{phenoEstimate}}. For details of the PhenoPath simulation
+#' see \code{\link{phenoSimulate}}.
+#'
+#' @name PhenoParams
+#' @rdname PhenoParams
+#' @aliases PhenoParams-class
+#' @exportClass PhenoParams
+setClass("PhenoParams",
+         contains = "Params",
+         slots = c(n.de = "numeric",
+                   n.pst = "numeric",
+                   n.pst.beta = "numeric",
+                   n.de.pst.beta = "numeric"),
+         prototype = prototype(n.de = 2500, n.pst = 2500, n.pst.beta = 2500,
+                               n.de.pst.beta = 2500))

R/PhenoParams-methods.R

+#' @rdname newParams
+#' @importFrom methods new
+#' @export
+newPhenoParams <- function(...) {
+
+    if (!requireNamespace("phenopath", quietly = TRUE)) {
+        stop("The PhenoPath simulation requires the 'phenopath' package.")
+    }
+
+    params <- new("PhenoParams")
+    params <- setParams(params, ...)
+
+    return(params)
+}
+
+setValidity("PhenoParams", function(object) {
+
+    v <- getParams(object, slotNames(object))
+
+    checks <- c(nGenes = checkmate::checkInt(v$nGenes, lower = 1),
+                nCells = checkmate::checkInt(v$nCells, lower = 1),
+                n.de = checkmate::checkInt(v$n.de, lower = 0),
+                n.pst = checkmate::checkInt(v$n.pst, lower = 0),
+                n.pst.beta = checkmate::checkInt(v$n.pst.beta, lower = 0),
+                n.de.pst.beta = checkmate::checkInt(v$n.de.pst.beta, lower = 0),
+                seed = checkmate::checkInt(v$seed, lower = 0))
+
+    if (v$nGenes != (v$n.de + v$n.pst + v$n.pst.beta + v$n.de.pst.beta)) {
+        checks <- c(checks,
+                    nGenes = paste("nGenes is not consistent with",
+                                   "n.de, n.pst, n.pst.beta, n.de.pst.beta"))
+    }
+
+    if (all(checks == TRUE)) {
+        valid <- TRUE
+    } else {
+        valid <- checks[checks != TRUE]
+        valid <- paste(names(valid), valid, sep = ": ")
+    }
+
+    return(valid)
+})
+
+#' @rdname setParam
+setMethod("setParam", "PhenoParams", function(object, name, value) {
+    checkmate::assertString(name)
+
+    if (name == "nGenes") {
+        stop(name, " cannot be set directly, set n.de, n.pst, n.pst.beta or ",
+             "n.de.pst.beta instead")
+    }
+
+    nNames <- c("n.de", "n.pst", "n.pst.beta", "n.de.pst.beta")
+    if (name %in% nNames) {
+        checkmate::assertInt(value, lower = 0)
+        total <- value
+        for (nName in nNames) {
+            if (nName != name) {
+                total <- total + getParam(object, nName)
+            }
+        }
+        object <- setParamUnchecked(object, "nGenes", total)
+    }
+
+    object <- callNextMethod()
+
+    return(object)
+})
+
+setMethod("show", "PhenoParams", function(object) {
+
+    pp <- list("Genes:"  = c("[DE]"              = "n.de",
+                             "[PST]"             = "n.pst",
+                             "[PST + Beta]"      = "n.pst.beta",
+                             "[DE + PST + Beta]" = "n.de.pst.beta"))
+
+    callNextMethod()
+    showPP(object, pp)
+})

tests/testthat/test-PhenoParams.R

+context("PhenoParams")
+
+test_that("constructor is valid", {
+    expect_true(validObject(newSCDDParams()))
+})
+
+test_that("nGenes checks work", {
+    params <- newPhenoParams()
+    expect_error(setParam(params, "nGenes", 1),
+                 "nGenes cannot be set directly")
+    params <- setParam(params, "n.de", 0)
+    total <- getParam(params, "n.de") + getParam(params, "n.pst") +
+             getParam(params, "n.pst.beta") + getParam(params, "n.de.pst.beta")
+    expect_equal(getParam(params, "nGenes"), total)
+})