Add paths parameters

DESCRIPTION

 Package: splatter
 Type: Package
 Title: Simple Simulation of Single-cell RNA Sequencing Data
-Version: 1.9.2.9001
+Version: 1.9.2.9002
 Date: 2019-07-16
 Author: Luke Zappia
 Authors@R:

NEWS.md

+### Version 1.9.2.9002 (2019-07-16)
+
+* Add paths parameters
+
 ### Version 1.9.2.9001 (2019-07-16)
 
 * Add mean parameters

R/AllClasses.R

@@ -283,6 +283,13 @@ setClass("SplatParams",
 #'             network.}
 #'         }
 #'     }
+#'     \item{\emph{Paths parameters}}{
+#'         \describe{
+#'             \item{\code{[paths.programs]}}{Number of expression programs.}
+#'             \item{\code{[paths.design]}}{data.frame describing path
+#'             structure.}
+#'         }
+#'     }
 #' }
 #'
 #' The parameters not shown in brackets can be estimated from real data using
@@ -300,13 +307,23 @@ setClass("SplotchParams",
                    mean.values = "numeric",
                    network.graph = "ANY",
                    network.nRegs = "numeric",
-                   network.regsSet = "logical"),
+                   network.regsSet = "logical",
+                   paths.nPrograms = "numeric",
+                   paths.design = "data.frame",
+                   paths.means = "list"),
          prototype = prototype(mean.rate = 0.3,
                                mean.shape = 0.6,
                                mean.values = numeric(),
                                network.graph = NULL,
                                network.nRegs = 100,
-                               network.regsSet = FALSE))
+                               network.regsSet = FALSE,
+                               paths.nPrograms = 10,
+                               paths.design = data.frame(
+                                   Path = 1,
+                                   From = 0,
+                                   Steps = 100
+                               ),
+                               paths.means = list()))
 
 #' The LunParams class
 #'

R/Params-methods.R

@@ -48,8 +48,11 @@ setMethod("show", "Params", function(object) {
 
     cat("A", crayon::bold("Params"), "object of class",
         crayon::bold(class(object)), "\n")
-    cat("Parameters can be (estimable) or", crayon::blue("[not estimable],"),
-        "'Default' or ", crayon::bold(crayon::green("'NOT DEFAULT'")), "\n\n")
+    cat("Parameters can be (estimable) or",
+        paste0(crayon::blue("[not estimable]"), ","),
+        "'Default' or ", crayon::bold(crayon::green("'NOT DEFAULT'")), "\n")
+    cat(crayon::bgYellow(crayon::black("Secondary")), "parameters are usually",
+        "set during simulation\n\n")
     showPP(object, pp)
     cat(length(slotNames(object)) - 3, "additional parameters", "\n\n")
 })

R/SplotchParams-methods.R

@@ -26,11 +26,16 @@ setValidity("SplotchParams", function(object) {
                                                       null.ok = TRUE),
                 network.nRegs = checkmate::checkInt(v$network.nRegs,
                                                     lower = 0),
-                network.regsSet = checkmate::checkFlag(v$network.regsSet))
-
-    if (checkmate::testNumeric(v$mean.values, len = 0)) {
-        checks <- c(checks, mean.values = TRUE)
-    } else {
+                network.regsSet = checkmate::checkFlag(v$network.regsSet),
+                paths.nPrograms = checkmate::checkInt(v$paths.nPrograms,
+                                                      lower = 1),
+                paths.design = checkmate::checkDataFrame(v$paths.design,
+                                                         types = "numeric",
+                                                         any.missing = FALSE,
+                                                         min.rows = 1,
+                                                         ncols = 3))
+
+    if (!checkmate::testNumeric(v$mean.values, len = 0)) {
         checks <- c(checks,
                     mean.values = checkmate::checkNumeric(v$mean.values,
                                                           lower = 0,
@@ -39,6 +44,35 @@ setValidity("SplotchParams", function(object) {
                                                           len = v$nGenes))
     }
 
+    if (!all(colnames(v$paths.design) == c("Path", "From", "Steps"))) {
+        checks <- c(checks, paths.design = "Incorrect column names")
+    } else {
+        if (!(0 %in% v$paths.design$From)) {
+            checks <- c(checks, paths.design = paste("origin must be specified",
+                      "in paths.design"))
+        }
+
+        paths.graph <- igraph::graph_from_data_frame(v$paths.design)
+        if (!igraph::is_simple(paths.graph)) {
+            checks <- c(checks, paths.design = "graph is not simple")
+        }
+        if (!igraph::is_connected(paths.graph)) {
+            checks <- c(checks, paths.design = "graph is not connected")
+        }
+        if (!igraph::is_dag(paths.graph)) {
+            checks <- c(checks, paths.design = "graph is not a DAG")
+        }
+    }
+
+    if (!checkmate::testList(v$paths.means, len = 0)) {
+        checks <- c(checks,
+                    paths.means = checkmate::checkList(v$paths.means,
+                                                       types = "matrix",
+                                                       any.missing = FALSE,
+                                                       len = nrow(v$paths.design),
+                                                       names = "unique"))
+    }
+
     if (all(checks == TRUE)) {
         valid <- TRUE
     } else {
@@ -52,14 +86,22 @@ setValidity("SplotchParams", function(object) {
 #' @importFrom methods show
 setMethod("show", "SplotchParams", function(object) {
 
-    pp.top <- list("Mean:" = c("(Rate)"   = "mean.rate",
-                               "(Shape)"  = "mean.shape",
-                               "[Values]" = "mean.values"))
+    pp.top <- list("Mean:" = c("(Rate)"    = "mean.rate",
+                               "(Shape)"   = "mean.shape",
+                               "[Values]*" = "mean.values"))
 
     pp.network <- list("Network:" = c("[Graph]"   = "network.graph",
                                       "[nRegs]"   = "network.nRegs",
                                       "[regsSet]" = "network.regsSet"))
 
+    pp.paths <- list("Paths:" = c("[nPrograms]" = "paths.nPrograms",
+                                  "[Design]"  = "paths.design"))
+
+    paths.means <- getParam(object, "paths.means")
+    if (length(paths.means) == 0) {
+        pp.paths[[1]] <- c(pp.paths[[1]], "[Means]*" = "paths.means")
+    }
+
     callNextMethod()
 
     showPP(object, pp.top)
@@ -82,6 +124,15 @@ setMethod("show", "SplotchParams", function(object) {
                              network.values$`[regsSet]` != FALSE)
         showValues(network.values, network.default)
     }
+
+    showPP(object, pp.paths)
+
+    if (length(paths.means) != 0) {
+        cat(crayon::bgYellow(crayon::bold(crayon::blue("[MEANS]\n"))))
+        cat(crayon::bold(crayon::green(paste(
+            "List of", length(paths.means), "matrices"
+        ))))
+    }
 })
 
 #' @rdname setParam

R/params-functions.R

@@ -122,15 +122,19 @@ showValues <- function(values, not.default) {
     items.per.line <- floor(screen.width / (max.len + 2))
 
     short.names <- names(short.values)
-    short.values <- crayon::col_align(short.values, max.len, "right")
-    short.names <- crayon::col_align(short.names, max.len, "right")
-
     not.est <- !grepl("\\(", short.names)
+    secondary <- grepl("\\*", short.names)
+    short.names <- gsub("\\*", "", short.names)
+
     short.names[not.est] <- crayon::blue(short.names[not.est])
+    short.names[secondary] <- crayon::bgYellow(short.names[secondary])
     short.names[not.default] <- crayon::bold(short.names[not.default])
     short.values[not.default] <- crayon::green(short.values[not.default])
     short.values[not.default] <- crayon::bold(short.values[not.default])
 
+    short.values <- crayon::col_align(short.values, max.len, "right")
+    short.names <- crayon::col_align(short.names, max.len, "right")
+
     names(short.values) <- short.names
 
     values.list <- split(short.values,
@@ -177,6 +181,8 @@ showDFs <- function(dfs, not.default) {
         cat(paste0("\n", name, "\n"))
         cat(msg, "\n")
         print(head(df, n = 4))
-        cat("# ... with", nrow(df) - 4, "more rows\n")
+        if (nrow(df) > 4) {
+            cat("# ... with", nrow(df) - 4, "more rows\n")
+        }
     }
 }

R/splotch-simulate.R

@@ -45,6 +45,7 @@ splotchSimulate <- function(params = newSplotchParams(), verbose = TRUE, ...) {
         if (verbose) {message("Using selected regulators...")}
     }
 
+    # Generate means
     if (length(getParam(params, "mean.values")) == 0) {
         if (verbose) {message("Simulating means...")}
         mean.shape <- getParam(params, "mean.shape")
@@ -55,6 +56,54 @@ splotchSimulate <- function(params = newSplotchParams(), verbose = TRUE, ...) {
         if (verbose) {message("Using defined means...")}
     }
 
+    # Generate paths
+    paths.design <- getParam(params, "paths.design")
+    network.graph <- getParam(params, "network.graph")
+    network.weights <- igraph::as_adjacency_matrix(network.graph,
+                                                   attr = "weight")
+    network.nRegs <- getParam(params, "network.nRegs")
+    network.isReg <- igraph::vertex_attr(network.graph, "IsReg")
+    paths.nPrograms <- getParam(params, "paths.nPrograms")
+    programs.weights <- matrix(rnorm(network.nRegs * paths.nPrograms),
+                               nrow = network.nRegs, ncol = paths.nPrograms)
+    paths.changes <- vector("list", nrow(paths.design))
+    paths.factors <- vector("list", nrow(paths.design))
+    for (path in seq_len(nrow(paths.design))) {
+        nSteps <- paths.design$Steps[path]
+        from <- paths.design$From[path]
+        changes <- matrix(0, nrow = nGenes, ncol = nSteps + 1)
+
+        if (from != 0) {
+            from.changes <- paths.changes[[from]]
+            changes[, 1] <- from.changes[, ncol(from.changes)]
+        }
+
+        for (step in seq_len(nSteps) + 1) {
+            programs.changes <- rnorm(paths.nPrograms)
+            reg.changes <- as.vector(programs.weights %*% programs.changes)
+            changes[network.isReg, step] <- reg.changes
+            change <- as.vector(changes[, step - 1] %*% network.weights)
+            changes[, step] <- changes[, step] + change
+        }
+
+        if (from == 0) {
+            changes <- changes[, 1:nSteps]
+            factors <- matrixStats::rowCumsums(changes)
+        } else {
+            changes <- changes[, 2:nSteps + 1]
+            from.factors <- paths.factors[[from]][, ncol(paths.factors[[from]])]
+            factors <- matrixStats::rowCumsums(changes) + from.factors
+        }
+        paths.changes[[path]] <- changes
+        paths.factors[[path]] <- factors
+    }
+    means.values <- getParam(params, "mean.values")
+    paths.means <- lapply(paths.factors, function(x) {
+        2 ^ x * means.values
+    })
+    names(paths.means) <- paste0("Path", paths.design$Path)
+    params <- setParam(params, "paths.means", paths.means)
+
     # Simulate base gene means
 
     # sim <- SingleCellExperiment(assays = list(counts = counts),

man/SplotchParams.Rd

@@ -33,6 +33,13 @@ The Splotch simulation uses the following parameters:
             network.}
         }
     }
+    \item{\emph{Paths parameters}}{
+        \describe{
+            \item{\code{[paths.programs]}}{Number of expression programs.}
+            \item{\code{[paths.design]}}{data.frame describing path
+            structure.}
+        }
+    }
 }
 
 The parameters not shown in brackets can be estimated from real data using