diff --git a/DESCRIPTION b/DESCRIPTION index 39cff9ac197b426cc36fc5774d09a9b2d0985f45..f3581ec089d72c72214418ae2cbb3cc0e4a66be8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ 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: diff --git a/NEWS.md b/NEWS.md index b1ae280635dab454ffa65ef498e2bbe5643116a2..db32f1f77f85cfbef0050219f46ed98e934d1c10 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,7 @@ +### Version 1.9.2.9002 (2019-07-16) + +* Add paths parameters + ### Version 1.9.2.9001 (2019-07-16) * Add mean parameters diff --git a/R/AllClasses.R b/R/AllClasses.R index d2088858a581b45c3f51cd28068e6adf4546c140..35fc2afedc9b42d876e045a9680330fa20ffeae0 100644 --- a/R/AllClasses.R +++ b/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 #' diff --git a/R/Params-methods.R b/R/Params-methods.R index 4f01bfecfd454763b738bc1127239dbaca742459..6bb8a0005dae65e2981a66712cdfabe90ba9e5a6 100644 --- a/R/Params-methods.R +++ b/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") }) diff --git a/R/SplotchParams-methods.R b/R/SplotchParams-methods.R index 9727e8242d0ecbd71e7bbaa1f1a1ca7d88be6d01..53ab2977c80c617f0116913b549f50f4430ab28b 100644 --- a/R/SplotchParams-methods.R +++ b/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 diff --git a/R/params-functions.R b/R/params-functions.R index c969ba8dd0fd8e861c1951d7e3bd35b4ff210b0b..5e7eed904a0e1ca5c272f17cdb3c7a010a49ad9e 100644 --- a/R/params-functions.R +++ b/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") + } } } diff --git a/R/splotch-simulate.R b/R/splotch-simulate.R index 4a7c5ebbf08307f02382816e75741d055a015a96..e91e4b75facbc306aaa9463b70d1659b229cd1d0 100644 --- a/R/splotch-simulate.R +++ b/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), diff --git a/man/SplotchParams.Rd b/man/SplotchParams.Rd index e03a62b928438995c7885d4d4ade65726bfe6ad5..20c32bd729d61f6b839ca59272606efb88fb8d8c 100644 --- a/man/SplotchParams.Rd +++ b/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