diff --git a/DESCRIPTION b/DESCRIPTION index 37176877b37d73708279f5ad00866223e512572d..4be8b4b0849846355db27205e005ee484f1fc90a 100644 --- a/DESCRIPTION +++ b/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 diff --git a/R/AllClasses.R b/R/AllClasses.R index 536efced17047cef1f4b74ba0cca485c5cf6f904..e9a131c926fd7e0cd2bedae14601b4b5a814c837 100644 --- a/R/AllClasses.R +++ b/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)) diff --git a/R/PhenoParams-methods.R b/R/PhenoParams-methods.R new file mode 100644 index 0000000000000000000000000000000000000000..2151c52c6a877a3d7503040e55468f8159ff30f2 --- /dev/null +++ b/R/PhenoParams-methods.R @@ -0,0 +1,79 @@ +#' @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) +}) diff --git a/tests/testthat/test-PhenoParams.R b/tests/testthat/test-PhenoParams.R new file mode 100644 index 0000000000000000000000000000000000000000..535724ad0b4ddf631c7e9e10a4430a9be9d092d1 --- /dev/null +++ b/tests/testthat/test-PhenoParams.R @@ -0,0 +1,15 @@ +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) +})