Merge pull request #335 from zhewa/master

Sparse Matrix support and refactorings

.gitignore

@@ -15,6 +15,10 @@
 # produced vignettes
 vignettes/*.html
 vignettes/*.pdf
+vignettes/*.log
+inst/rmarkdown/*.html
+inst/rmarkdown/*.rds
+inst/rmarkdown/*.csv
 # OAuth2 token, see https://github.com/hadley/httr/releases/tag/v0.3
 .httr-oauth
 # knitr and R markdown default cache directories
@@ -29,6 +33,8 @@ celda.Rproj
 src/*.o
 src/*.dll
 src/*.so
+src-i386/*
+src-x64/*
 etc/*
 # Celda log files with default prefix
 Celda_chain.*log.txt
@@ -37,4 +43,5 @@ doc
 Meta
 .Rprofile
 renv/
+renv.lock
 

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: celda
 Title: CEllular Latent Dirichlet Allocation
-Version: 1.7.7
+Version: 1.7.9
 Authors@R: c(person("Joshua", "Campbell", email = "camp@bu.edu",
     role = c("aut", "cre")),
     person("Sean", "Corbett", email = "scorbett@bu.edu", role = c("aut")),
@@ -21,12 +21,12 @@ Imports: plyr, foreach, ggplot2, RColorBrewer, grid, scales, gtable,
         grDevices, graphics, matrixStats, doParallel, digest, methods,
         reshape2, S4Vectors, data.table,
         Rcpp, RcppEigen, uwot, enrichR, stringi, SummarizedExperiment,
-        MCMCprecision, ggrepel, Rtsne, withr, dendextend, ggdendro,
-        pROC, scater (>= 1.14.4), scran, SingleCellExperiment, dbscan,
-        DelayedArray, Seurat, stringr, Matrix, ComplexHeatmap, multipanelfigure,
+        MCMCprecision, ggrepel, Rtsne, withr,
+        scater (>= 1.14.4), scran, SingleCellExperiment, dbscan,
+        DelayedArray, stringr, Matrix, ComplexHeatmap, multipanelfigure,
         circlize
 Suggests: testthat, knitr, roxygen2, rmarkdown, biomaRt, covr,
-        BiocManager, BiocStyle, M3DExampleData, TENxPBMCData
+        BiocManager, BiocStyle, M3DExampleData, TENxPBMCData, singleCellTK
 LinkingTo: Rcpp, RcppEigen
 License: MIT + file LICENSE
 Encoding: UTF-8

NAMESPACE

@@ -30,9 +30,7 @@ export(distinctColors)
 export(factorizeMatrix)
 export(featureModuleLookup)
 export(featureModuleTable)
-export(findMarkersTree)
 export(geneSetEnrich)
-export(getDecisions)
 export(logLikelihood)
 export(logLikelihoodHistory)
 export(matrixNames)
@@ -49,10 +47,8 @@ export(plotDimReduceFeature)
 export(plotDimReduceGrid)
 export(plotDimReduceModule)
 export(plotGridSearchPerplexity)
-export(plotGridSearchPerplexityDiff)
 export(plotHeatmap)
-export(plotMarkerDendro)
-export(plotMarkerHeatmap)
+export(plotRPC)
 export(recodeClusterY)
 export(recodeClusterZ)
 export(recursiveSplitCell)
@@ -97,7 +93,6 @@ exportMethods(decontX)
 exportMethods(decontXcounts)
 exportMethods(factorizeMatrix)
 exportMethods(featureModuleLookup)
-exportMethods(findMarkersTree)
 exportMethods(geneSetEnrich)
 exportMethods(logLikelihood)
 exportMethods(logLikelihoodHistory)
@@ -111,7 +106,7 @@ exportMethods(plotDimReduceFeature)
 exportMethods(plotDimReduceGrid)
 exportMethods(plotDimReduceModule)
 exportMethods(plotGridSearchPerplexity)
-exportMethods(plotGridSearchPerplexityDiff)
+exportMethods(plotRPC)
 exportMethods(recursiveSplitCell)
 exportMethods(recursiveSplitModule)
 exportMethods(reorderCelda)
@@ -131,6 +126,9 @@ import(graphics)
 import(grid)
 import(uwot)
 importFrom(MCMCprecision,fit_dirichlet)
+importFrom(Matrix,colSums)
+importFrom(Matrix,rowSums)
+importFrom(Matrix,t)
 importFrom(RColorBrewer,brewer.pal)
 importFrom(Rtsne,Rtsne)
 importFrom(data.table,as.data.table)
@@ -160,10 +158,13 @@ importFrom(scales,dscale)
 importFrom(scales,hue_pal)
 importFrom(stringi,stri_list2matrix)
 importFrom(withr,with_seed)
+importMethodsFrom(Matrix,"%*%")
 useDynLib(celda,"_colSumByGroup")
 useDynLib(celda,"_colSumByGroupChange")
+useDynLib(celda,"_colSumByGroupChange_numeric")
 useDynLib(celda,"_colSumByGroup_numeric")
 useDynLib(celda,"_perplexityG")
 useDynLib(celda,"_rowSumByGroup")
 useDynLib(celda,"_rowSumByGroupChange")
+useDynLib(celda,"_rowSumByGroupChange_numeric")
 useDynLib(celda,"_rowSumByGroup_numeric")

R/RcppExports.R

@@ -42,6 +42,15 @@ eigenMatMultInt <- function(A, B) {
     .Call('_celda_eigenMatMultInt', PACKAGE = 'celda', A, B)
 }
 
+#' Fast matrix multiplication for double x double
+#' 
+#' @param A a double matrix
+#' @param B an integer matrix
+#' @return An integer matrix representing the product of A and B
+eigenMatMultNumeric <- function(A, B) {
+    .Call('_celda_eigenMatMultNumeric', PACKAGE = 'celda', A, B)
+}
+
 #' Fast normalization for numeric matrix
 #' 
 #' @param R_counts An integer matrix
@@ -77,3 +86,19 @@ nonzero <- function(R_counts) {
     .Call('_celda_nonzero', PACKAGE = 'celda', R_counts)
 }
 
+colSumByGroupSparse <- function(counts, group, K) {
+    .Call('_celda_colSumByGroupSparse', PACKAGE = 'celda', counts, group, K)
+}
+
+rowSumByGroupSparse <- function(counts, group, L) {
+    .Call('_celda_rowSumByGroupSparse', PACKAGE = 'celda', counts, group, L)
+}
+
+colSumByGroupChangeSparse <- function(counts, px, group, pgroup, K) {
+    .Call('_celda_colSumByGroupChangeSparse', PACKAGE = 'celda', counts, px, group, pgroup, K)
+}
+
+rowSumByGroupChangeSparse <- function(counts, px, group, pgroup, L) {
+    .Call('_celda_rowSumByGroupChangeSparse', PACKAGE = 'celda', counts, px, group, pgroup, L)
+}
+

R/accessors.R

@@ -15,7 +15,6 @@
 #'  to use. Default "featureSubset".
 #' @param value Character vector of cell cluster labels for replacements. Works
 #'  only if \code{x} is a \linkS4class{SingleCellExperiment} object.
-#' @param ... Ignored. Placeholder to prevent check warning.
 #' @return One of
 #' \itemize{
 #'  \item Character vector if \code{x} is a
@@ -26,7 +25,7 @@
 #'  Models) and/or feature module labels (for celda_G and celdaCG Models).}
 #' @export
 setGeneric("celdaClusters",
-    function(x, ...) {
+    function(x, altExpName = "featureSubset") {
         standardGeneric("celdaClusters")
     })
 
@@ -68,9 +67,13 @@ setGeneric("celdaClusters<-",
 
 #' @rdname celdaClusters
 #' @export
-setReplaceMethod("celdaClusters", signature(x = "SingleCellExperiment"),
+setMethod("celdaClusters<-", signature(x = "SingleCellExperiment"),
     function(x, altExpName = "featureSubset", value) {
         altExp <- SingleCellExperiment::altExp(x, altExpName)
+        if (!is.factor(value)) {
+            message("Cluster labels are converted to factors.")
+            value <- as.factor(value)
+        }
         SummarizedExperiment::colData(altExp)$celda_cell_cluster <- value
         SingleCellExperiment::altExp(x, altExpName) <- altExp
         return(x)
@@ -122,9 +125,13 @@ setGeneric("celdaModules<-",
 
 #' @rdname celdaModules
 #' @export
-setReplaceMethod("celdaModules", signature(sce = "SingleCellExperiment"),
+setMethod("celdaModules<-", signature(sce = "SingleCellExperiment"),
     function(sce, altExpName = "featureSubset", value) {
         altExp <- SingleCellExperiment::altExp(sce, altExpName)
+        if (!is.factor(value)) {
+            message("Module labels are converted to factors.")
+            value <- as.factor(value)
+        }
         SummarizedExperiment::rowData(altExp)$celda_feature_module <- value
         SingleCellExperiment::altExp(sce, altExpName) <- altExp
         return(sce)
@@ -145,12 +152,11 @@ setReplaceMethod("celdaModules", signature(sce = "SingleCellExperiment"),
 #'  to use. Default "featureSubset".
 #' @param value Character vector of sample labels for replacements. Works
 #'  only is \code{x} is a \linkS4class{SingleCellExperiment} object.
-#' @param ... Ignored. Placeholder to prevent check warning.
 #' @return Character vector. Contains the sample labels provided at model
 #'  creation, or those automatically generated by celda.
 #' @export
 setGeneric("sampleLabel",
-    function(x, ...) {
+    function(x, altExpName = "featureSubset") {
         standardGeneric("sampleLabel")
     })
 
@@ -177,9 +183,13 @@ setGeneric("sampleLabel<-",
 )
 #' @rdname sampleLabel
 #' @export
-setReplaceMethod("sampleLabel", signature(x = "SingleCellExperiment"),
+setMethod("sampleLabel<-", signature(x = "SingleCellExperiment"),
     function(x, altExpName = "featureSubset", value) {
         altExp <- SingleCellExperiment::altExp(x, altExpName)
+        if (!is.factor(value)) {
+            message("Sample labels are converted to factors.")
+            value <- as.factor(value)
+        }
         SummarizedExperiment::colData(altExp)$celda_sample_label <- value
         SingleCellExperiment::altExp(x, altExpName) <- altExp
         return(x)
@@ -265,13 +275,12 @@ setMethod("matrixNames",
 #'  \code{celdaList}.
 #' @param altExpName The name for the \link{altExp} slot
 #'  to use. Default "featureSubset".
-#' @param ... Ignored. Placeholder to prevent check warning.
 #' @return Data Frame. Contains details on the various K/L parameters, chain
 #'  parameters, seed, and final log-likelihoods derived for each model in the
 #'  provided celdaList.
 #' @export
 setGeneric("runParams",
-    function(x, ...) {
+    function(x, altExpName = "featureSubset") {
         standardGeneric("runParams")
     }
 )
@@ -312,13 +321,12 @@ setMethod("runParams",
 #'  \code{celdaList}.
 #' @param altExpName The name for the \link{altExp} slot
 #'  to use. Default "featureSubset".
-#' @param ... Ignored. Placeholder to prevent check warning.
 #' @return List. Contains one celdaModel object for each of the parameters
 #'  specified in \code{runParams(x)}.
 #' @export
 setGeneric(
     "resList",
-    function(x, ...) {
+    function(x, altExpName = "featureSubset") {
         standardGeneric("resList")
     }
 )
@@ -359,17 +367,18 @@ setMethod("resList",
 #'  returned by \link{celda_C}, \link{celda_G}, or \link{celda_CG}.
 #' @param altExpName The name for the \link{altExp} slot
 #'  to use. Default "featureSubset".
-#' @param ... Ignored. Placeholder to prevent check warning.
 #' @return Character. The celda model. Can be one of "celda_C", "celda_G", or
 #'  "celda_CG".
 #' @examples
 #' data(sceCeldaCG)
 #' celdaModel(sceCeldaCG)
 #' @export
 setGeneric("celdaModel",
-    function(sce, ...) {
+    function(sce, altExpName = "featureSubset") {
         standardGeneric("celdaModel")
     })
+
+
 #' @rdname celdaModel
 #' @export
 setMethod("celdaModel",
@@ -418,6 +427,8 @@ setGeneric(
         standardGeneric("celdaPerplexity")
     }
 )
+
+
 #' @title Get perplexity for every model in a celdaList
 #' @description Returns perplexity for each model in a celdaList as calculated
 #'  by `perplexity().`
@@ -452,6 +463,8 @@ setGeneric(
         standardGeneric("countChecksum")
     }
 )
+
+
 #' @title Get the MD5 hash of the count matrix from the celdaList
 #' @description Returns the MD5 hash of the count matrix used to generate the
 #'  celdaList.

R/celdaGridSearch.R

@@ -46,7 +46,6 @@
 #' @return A \linkS4class{SingleCellExperiment} object. Function
 #'  parameter settings and celda model results are stored in the
 #'  \link{metadata} \code{"celda_grid_search"} slot.
-#' @param ... Ignored. Placeholder to prevent check warning.
 #' @seealso \link{celda_G} for feature clustering, \link{celda_C} for
 #'  clustering of cells, and \link{celda_CG} for simultaneous clustering of
 #'  features and cells. \link{subsetCeldaList} can subset the \code{celdaList}
@@ -56,7 +55,7 @@
 #' @importFrom doParallel registerDoParallel
 #' @importFrom methods is
 #' @examples
-#' \dontrun{
+#' \donttest{
 #' data(celdaCGSim)
 #' ## Run various combinations of parameters with 'celdaGridSearch'
 #' celdaCGGridSearchRes <- celdaGridSearch(celdaCGSim$counts,
@@ -68,7 +67,22 @@
 #'   cores = 1)
 #' }
 #' @export
-setGeneric("celdaGridSearch", function(x, ...) {
+setGeneric("celdaGridSearch",
+    function(
+        x,
+        useAssay = "counts",
+        altExpName = "featureSubset",
+        model,
+        paramsTest,
+        paramsFixed = NULL,
+        maxIter = 200,
+        nchains = 3,
+        cores = 1,
+        bestOnly = TRUE,
+        seed = 12345,
+        perplexity = TRUE,
+        verbose = TRUE,
+        logfilePrefix = "Celda") {
     standardGeneric("celdaGridSearch")})
 
 
@@ -442,7 +456,6 @@ setMethod("celdaGridSearch",
 #'  models in list \code{"celda_grid_search"} in \code{metadata(x)}.
 #' @param altExpName The name for the \link{altExp} slot
 #'  to use. Default "featureSubset".
-#' @param ... Ignored. Placeholder to prevent check warning.
 #' @return One of
 #' \itemize{
 #'  \item A new \linkS4class{SingleCellExperiment} object containing
@@ -464,7 +477,9 @@ setMethod("celdaGridSearch",
 #'  chains in parallel. \link{selectBestModel} can get the best model for each
 #'  combination of parameters.
 #' @export
-setGeneric("subsetCeldaList", function(x, ...) {
+setGeneric("subsetCeldaList",
+    function(x, params, altExpName = "featureSubset") {
+
     standardGeneric("subsetCeldaList")})
 
 
@@ -583,7 +598,6 @@ setMethod("subsetCeldaList",
 #'  corresponding celda model object.
 #' @param altExpName The name for the \link{altExp} slot
 #'  to use. Default "featureSubset".
-#' @param ... Ignored. Placeholder to prevent check warning.
 #' @return One of
 #' \itemize{
 #'  \item A new \linkS4class{SingleCellExperiment} object containing
@@ -602,7 +616,9 @@ setMethod("subsetCeldaList",
 #'  instead of a \code{celdaList} object.}
 #' @seealso \link{celdaGridSearch} \link{subsetCeldaList}
 #' @export
-setGeneric("selectBestModel", function(x, ...) {
+setGeneric("selectBestModel",
+    function(x, asList = FALSE, altExpName = "featureSubset") {
+
     standardGeneric("selectBestModel")})