CRAN release

welch-lab · Dec 13, 2023 · 29373ed · 29373ed
1 parent 0d0ad92
commit 29373ed
Show file tree

Hide file tree

Showing 20 changed files with 200 additions and 845 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -2,14 +2,21 @@ Package: CytoSimplex
 Type: Package
 Title: Simplex Visualization of Cell Fate Similarity in Single-Cell Data
 Version: 0.1.0
-Author: Yichen Wang [aut, cre],
-        Jialin Liu [aut],
-        Joshua D. Welch [cph]
+Authors@R: c(
+    person(given = 'Yichen', family = 'Wang', email = '[email protected]', 
+           role = c('aut', 'cre'), comment = c(ORCID = "0000-0003-4347-5199")),
+    person(given = 'Jialin', family = 'Liu', email = '[email protected]', 
+           role = c('aut'), comment = c(ORCID = "0000-0002-9984-7695")),
+    person(given = 'Joshua', family = 'Welch', email = '[email protected]', 
+           role = c('cph'))
+  )
 Maintainer: Yichen Wang <[email protected]>
-Description: Create simplex plot to visualize the similarity between 
+Description: Create simplex plots to visualize the similarity between 
     single-cells and selected clusters in a 1-/2-/3-simplex space.
-    Velocity information can be added as an additional layer.
-License: GPL-3 | file LICENSE
+    Velocity information can be added as an additional layer. 
+    See Liu J, Wang Y et al (2023) <doi:10.1101/2023.12.07.570655> for more details.
+URL: https://welch-lab.github.io/CytoSimplex/, https://github.com/welch-lab/CytoSimplex
+License: GPL-3
 Encoding: UTF-8
 LazyData: true
 Depends:

diff --git a/LICENSE b/LICENSE
diff --git a/NAMESPACE b/NAMESPACE
@@ -3,6 +3,7 @@
 S3method(colNormalize,Seurat)
 S3method(colNormalize,SingleCellExperiment)
 S3method(colNormalize,default)
+S3method(colNormalize,dgCMatrix)
 S3method(plotBinary,Seurat)
 S3method(plotBinary,SingleCellExperiment)
 S3method(plotBinary,default)

diff --git a/R/binary.R b/R/binary.R
@@ -135,13 +135,13 @@ plotBinary.default <- function(
 #' @export
 #' @method plotBinary Seurat
 #' @examples
-#'
+#' \donttest{
 #' # Seurat example
-#' if (FALSE) {
-#'     srt <- CreateSeuratObject(rnaRaw)
-#'     Idents(srt) <- rnaCluster
-#'     gene <- selectTopFeatures(srt, vertices = c("OS", "RE"))
-#'     plotBinary(srt, features = gene, vertices = c("OS", "RE"))
+#' library(Seurat)
+#' srt <- CreateSeuratObject(rnaRaw)
+#' Idents(srt) <- rnaCluster
+#' gene <- selectTopFeatures(srt, vertices = c("OS", "RE"))
+#' plotBinary(srt, features = gene, vertices = c("OS", "RE"))
 #' }
 plotBinary.Seurat <- function(
         x,
@@ -166,14 +166,13 @@ plotBinary.Seurat <- function(
 #' @export
 #' @method plotBinary SingleCellExperiment
 #' @examples
-#'
+#' \donttest{
 #' # SingleCellExperiment example
-#' if (FALSE) {
-#'     library(SingleCellExperiment)
-#'     sce <- SingleCellExperiment(assays = list(counts = rnaRaw))
-#'     colLabels(sce) <- rnaCluster
-#'     gene <- selectTopFeatures(sce, vertices = c("OS", "RE"))
-#'     plotBinary(sce, features = gene, vertices = c("OS", "RE"))
+#' library(SingleCellExperiment)
+#' sce <- SingleCellExperiment(assays = list(counts = rnaRaw))
+#' colLabels(sce) <- rnaCluster
+#' gene <- selectTopFeatures(sce, vertices = c("OS", "RE"))
+#' plotBinary(sce, features = gene, vertices = c("OS", "RE"))
 #' }
 plotBinary.SingleCellExperiment <- function(
         x,

diff --git a/R/normalize.R b/R/normalize.R
@@ -15,40 +15,44 @@ colNormalize <- function(x, scaleFactor = NULL, log = FALSE, ...) {
     UseMethod("colNormalize", x)
 }
 
+
 #' @rdname colNormalize
 #' @export
 #' @method colNormalize default
 colNormalize.default <- function(x, scaleFactor = NULL, log = FALSE, ...) {
-    if (inherits(x, "dgCMatrix")) {
-        x@x <- x@x / rep.int(Matrix::colSums(x), diff(x@p))
-    } else if (is.matrix(x)) {
-        dn <- dimnames(x)
-        x <- colNormalize_dense(x, base::colSums(x))
-        dimnames(x) <- dn
-    } else {
-        stop("Input matrix of class ", class(x)[1], " is not yet supported.")
-    }
+    dn <- dimnames(x)
+    x <- colNormalize_dense(x, base::colSums(x))
+    dimnames(x) <- dn
+    if (!is.null(scaleFactor)) x <- x * scaleFactor
+    if (isTRUE(log)) x <- log1p(x)
+    return(x)
+}
+
+#' @rdname colNormalize
+#' @export
+#' @method colNormalize dgCMatrix
+colNormalize.dgCMatrix <- function(x, scaleFactor = NULL, log = FALSE, ...) {
+    x@x <- x@x / rep.int(Matrix::colSums(x), diff(x@p))
     if (!is.null(scaleFactor)) x <- x * scaleFactor
     if (isTRUE(log)) x <- log1p(x)
     return(x)
 }
 
 #' @rdname colNormalize
-#' @param layer For "Seurat" method, which layer of the assay to be used.
-#' Default \code{"counts"}.
 #' @param assay For "Seurat" method, the specific assay to get data from.
 #' Default \code{NULL} to the default assay.
+#' @param layer For "Seurat" method, which layer of the assay to be used.
+#' Default \code{"counts"}.
 #' @return A Seurat object with normalized data in the specified slot of the
 #' specified assay.
 #' @export
 #' @method colNormalize Seurat
 #' @examples
-#'
+#' \donttest{
 #' # Seurat example
-#' if (FALSE) {
-#'     library(Seurat)
-#'     srt <- CreateSeuratObject(rnaRaw)
-#'     srt <- colNormalize(srt)
+#' library(Seurat)
+#' srt <- CreateSeuratObject(rnaRaw)
+#' srt <- colNormalize(srt)
 #' }
 colNormalize.Seurat <- function(
     x,
@@ -60,7 +64,7 @@ colNormalize.Seurat <- function(
 ) {
     value <- .getSeuratData(x, assay = assay, layer = layer, clusterVar = NULL)
     mat <- value[[1]]
-    norm <- colNormalize.default(mat, scaleFactor = scaleFactor, log = log)
+    norm <- colNormalize(mat, scaleFactor = scaleFactor, log = log)
     SeuratObject::LayerData(x, layer = "data", assay = assay) <- norm
     return(x)
 }
@@ -74,12 +78,11 @@ colNormalize.Seurat <- function(
 #' @export
 #' @method colNormalize SingleCellExperiment
 #' @examples
-#'
+#' \donttest{
 #' # SingleCellExperiment example
-#' if (FALSE) {
-#'     library(SingleCellExperiment)
-#'     sce <- SingleCellExperiment(assays = list(counts = rnaRaw))
-#'     sce <- colNormalize(sce)
+#' library(SingleCellExperiment)
+#' sce <- SingleCellExperiment(assays = list(counts = rnaRaw))
+#' sce <- colNormalize(sce)
 #' }
 colNormalize.SingleCellExperiment <- function(
     x,
@@ -90,7 +93,7 @@ colNormalize.SingleCellExperiment <- function(
 ) {
     value <- .getSCEData(x, clusterVar = NULL, assay.type = assay.type)
     mat <- value[[1]]
-    norm <- colNormalize.default(mat, scaleFactor = scaleFactor, log = log)
+    norm <- colNormalize(mat, scaleFactor = scaleFactor, log = log)
     if (isTRUE(log)) SingleCellExperiment::logcounts(x) <- norm
     else SingleCellExperiment::normcounts(x) <- norm
 

diff --git a/R/quaternary.R b/R/quaternary.R
@@ -3,7 +3,7 @@
 #' Create quaternary plots that show similarity between single cells and
 #' selected four terminals in a baricentric coordinate.
 #'
-#' See \code{\link{plotTernary}} for more details.
+#' See \code{\link{plotTernary}} for more details on methodologies.
 #'
 #' A dynamic rotating view in a GIF image file can be created with
 #' \code{\link{writeQuaternaryGIF}}. Package \code{magick} must be installed in
@@ -22,8 +22,7 @@
 #' variable name in interactive console.
 #' @examples
 #' gene <- selectTopFeatures(rnaRaw, rnaCluster, c("RE", "OS", "CH", "ORT"))
-#' plotQuaternary(rnaRaw, rnaCluster, c("RE", "OS", "CH", "ORT"), gene,
-#'                interactive = FALSE)
+#' plotQuaternary(rnaRaw, rnaCluster, c("RE", "OS", "CH", "ORT"), gene)
 plotQuaternary <- function(x, ...) {
     UseMethod('plotQuaternary', x)
 }
@@ -163,14 +162,14 @@ plotQuaternary.default <- function(
 #' @export
 #' @method plotQuaternary Seurat
 #' @examples
-#'
+#' \donttest{
 #' # Seurat example
-#' if (FALSE) {
-#'     srt <- CreateSeuratObject(rnaRaw)
-#'     Idents(srt) <- rnaCluster
-#'     gene <- selectTopFeatures(srt, vertices = c("OS", "RE", "CH", "ORT"))
-#'     plotQuaternary(srt, features = gene,
-#'                    vertices = c("OS", "RE", "CH", "ORT"))
+#' library(Seurat)
+#' srt <- CreateSeuratObject(rnaRaw)
+#' Idents(srt) <- rnaCluster
+#' gene <- selectTopFeatures(srt, vertices = c("OS", "RE", "CH", "ORT"))
+#' plotQuaternary(srt, features = gene,
+#'                vertices = c("OS", "RE", "CH", "ORT"))
 #' }
 plotQuaternary.Seurat <- function(
         x,
@@ -195,15 +194,14 @@ plotQuaternary.Seurat <- function(
 #' @export
 #' @method plotQuaternary SingleCellExperiment
 #' @examples
-#'
+#' \donttest{
 #' # SingleCellExperiment example
-#' if (FALSE) {
-#'     library(SingleCellExperiment)
-#'     sce <- SingleCellExperiment(assays = list(counts = rnaRaw))
-#'     colLabels(sce) <- rnaCluster
-#'     gene <- selectTopFeatures(sce, vertices = c("OS", "RE", "CH", "ORT"))
-#'     plotQuaternary(sce, features = gene,
-#'                    vertices = c("OS", "RE", "CH", "ORT"))
+#' library(SingleCellExperiment)
+#' sce <- SingleCellExperiment(assays = list(counts = rnaRaw))
+#' colLabels(sce) <- rnaCluster
+#' gene <- selectTopFeatures(sce, vertices = c("OS", "RE", "CH", "ORT"))
+#' plotQuaternary(sce, features = gene,
+#'                vertices = c("OS", "RE", "CH", "ORT"))
 #' }
 plotQuaternary.SingleCellExperiment <- function(
         x,
@@ -335,9 +333,8 @@ plotQuaternary.simMat <- function(
     cellCart <- rotateByZAxis(cellCart, theta)
     # Plot data
     grDevices::pdf(nullfile())
-    graphics::par(xpd = FALSE)
     scatter3D(cellCart[,1], cellCart[,2], cellCart[,3],
-              main = list(title, cex = titleSize, col = titleColor),
+              main = list(title, cex = titleSize, col = titleColor), outer = FALSE,
               xlim = c(-1.2, 1.2), ylim = c(-1.2, 1.2), zlim = c(0, 1.7),
               alpha = 0.8, col = dotColor, cex = dotSize/2, pch = 16, d = 3,
               colkey = list(plot = FALSE), expand = 0.7,
@@ -373,8 +370,18 @@ setOldClass("plist")
 #' @rdname show-plist
 #' @title Show plist object produced with plot3D package
 #' @param object,x plist object
-#' @param ... Not used.
+#' @param ... Graphic parameters passed to \code{\link{plot}}. \code{mar} is
+#' pre-specified.
 #' @export
+#' @return No return value. It displays the plot described in a 'plist' object
+#' returned by \code{\link{plotQuaternary}}, internally created by package
+#' 'plot3D'.
+#' @examples
+#' gene <- selectTopFeatures(rnaRaw, rnaCluster, c("RE", "OS", "CH", "ORT"))
+#' plistObj <- plotQuaternary(rnaRaw, rnaCluster, c("RE", "OS", "CH", "ORT"), gene)
+#' print(plistObj)
+#' # equivalent to
+#' show(plistObj)
 setMethod("show", "plist", function(object) {
     print(object)
 }
@@ -384,8 +391,9 @@ setMethod("show", "plist", function(object) {
 #' @method print plist
 #' @export
 print.plist <- function(x, ...) {
-    graphics::par(mar = c(1, 1, 0, 1), oma = c(0, 0, 0, 0),
-                  mgp = c(0, 0, 0), xpd = NA)
+    oldpar <- graphics::par(no.readonly = TRUE) # code line i
+    on.exit(graphics::par(oldpar))
+    graphics::par(mar = c(0, 0, 0, 0))
     plot(x, ...)
 }
 
@@ -477,9 +485,11 @@ rotateByZAxis <- function(coord, theta) {
 #' @export
 #' @examples
 #' gene <- selectTopFeatures(rnaRaw, rnaCluster, c("RE", "OS", "CH", "ORT"))
-#' if (requireNamespace("magick", quietly = TRUE))
-#'     writeQuaternaryGIF(rnaRaw, clusterVar = rnaCluster, features = gene,
-#'                        vertices = c("RE", "OS", "CH", "ORT"))
+#' \donttest{
+#' writeQuaternaryGIF(rnaRaw, clusterVar = rnaCluster, features = gene,
+#'                    vertices = c("RE", "OS", "CH", "ORT"),
+#'                    gifPath = paste0(tempfile(), ".gif"))
+#' }
 writeQuaternaryGIF <- function(
         x,
         ...,

diff --git a/R/selectTopFeatures.R b/R/selectTopFeatures.R
@@ -115,13 +115,12 @@ selectTopFeatures.default <- function(
 #' Default \code{"counts"}.
 #' @param assay Assay name of the Seurat object to be used. Default \code{NULL}.
 #' @examples
-#'
+#' \donttest{
 #' # Seurat example
-#' if (FALSE) {
-#'     library(Seurat)
-#'     srt <- CreateSeuratObject(rnaRaw)
-#'     Idents(srt) <- rnaCluster
-#'     gene <- selectTopFeatures(srt, vertices = c("OS", "RE"))
+#' library(Seurat)
+#' srt <- CreateSeuratObject(rnaRaw)
+#' Idents(srt) <- rnaCluster
+#' gene <- selectTopFeatures(srt, vertices = c("OS", "RE"))
 #' }
 selectTopFeatures.Seurat <- function(
     x,
@@ -147,13 +146,12 @@ selectTopFeatures.Seurat <- function(
 #' @param assay.type Assay name of the SingleCellExperiment object to be used.
 #' Default \code{"counts"}.
 #' @examples
-#'
+#' \donttest{
 #' # SingleCellExperiment example
-#' if (FALSE) {
-#'     library(SingleCellExperiment)
-#'     sce <- SingleCellExperiment(assays = list(counts = rnaRaw))
-#'     colLabels(sce) <- rnaCluster
-#'     gene <- selectTopFeatures(sce, vertices = c("OS", "RE"))
+#' library(SingleCellExperiment)
+#' sce <- SingleCellExperiment(assays = list(counts = rnaRaw))
+#' colLabels(sce) <- rnaCluster
+#' gene <- selectTopFeatures(sce, vertices = c("OS", "RE"))
 #' }
 selectTopFeatures.SingleCellExperiment <- function(
     x,

diff --git a/R/ternary.R b/R/ternary.R
@@ -177,13 +177,13 @@ plotTernary.default <- function(
 #' @export
 #' @method plotTernary Seurat
 #' @examples
-#'
+#' \donttest{
 #' # Seurat example
-#' if (FALSE) {
-#'     srt <- CreateSeuratObject(rnaRaw)
-#'     Idents(srt) <- rnaCluster
-#'     gene <- selectTopFeatures(srt, vertices = c("OS", "RE", "CH"))
-#'     plotTernary(srt, features = gene, vertices = c("OS", "RE", "CH"))
+#' library(Seurat)
+#' srt <- CreateSeuratObject(rnaRaw)
+#' Idents(srt) <- rnaCluster
+#' gene <- selectTopFeatures(srt, vertices = c("OS", "RE", "CH"))
+#' plotTernary(srt, features = gene, vertices = c("OS", "RE", "CH"))
 #' }
 plotTernary.Seurat <- function(
         x,
@@ -208,14 +208,13 @@ plotTernary.Seurat <- function(
 #' @export
 #' @method plotTernary SingleCellExperiment
 #' @examples
-#'
+#' \donttest{
 #' # SingleCellExperiment example
-#' if (FALSE) {
-#'     library(SingleCellExperiment)
-#'     sce <- SingleCellExperiment(assays = list(counts = rnaRaw))
-#'     colLabels(sce) <- rnaCluster
-#'     gene <- selectTopFeatures(sce, vertices = c("OS", "RE", "CH"))
-#'     plotTernary(sce, features = gene, vertices = c("OS", "RE", "CH"))
+#' library(SingleCellExperiment)
+#' sce <- SingleCellExperiment(assays = list(counts = rnaRaw))
+#' colLabels(sce) <- rnaCluster
+#' gene <- selectTopFeatures(sce, vertices = c("OS", "RE", "CH"))
+#' plotTernary(sce, features = gene, vertices = c("OS", "RE", "CH"))
 #' }
 plotTernary.SingleCellExperiment <- function(
         x,

diff --git a/R/util.R b/R/util.R
@@ -116,14 +116,10 @@ is.rawCounts <- function(x) {
     if (is.null(clusterVar)) {
         if (inherits(object, "SingleCellExperiment")) {
             clusterVar <- SingleCellExperiment::colLabels(object)
-        } else {
-            stop("No default labels available for this SCE object.")
         }
-    }
-    if (length(clusterVar) == 1) {
+    } else if (length(clusterVar) == 1) {
         clusterVar <- SummarizedExperiment::colData(object)[[clusterVar]]
-    }
-    if (length(clusterVar) != ncol(object)) {
+    } else if (length(clusterVar) != ncol(object)) {
         stop("Invalid `clusterVar`.")
     }
     return(list(mat, clusterVar))