diff --git a/R/quaternary.R b/R/quaternary.R index f8183f6..31ab1f5 100644 --- a/R/quaternary.R +++ b/R/quaternary.R @@ -132,7 +132,6 @@ plotQuaternary.default <- function( breaks = breaks, legendTitle = legendTitle ) - if (isFALSE(processed) && !is.rawCounts(x)) { cli::cli_alert_warning( "Input matrix is not raw counts (integers). Results may be affected." @@ -292,7 +291,7 @@ plotQuaternary.Seurat <- function( #' @examples #' \donttest{ #' # SingleCellExperiment example -#' if (requreNamespace("SingleCellExperiment", quietly = TRUE)) { +#' if (requireNamespace("SingleCellExperiment", quietly = TRUE)) { #' require(SingleCellExperiment) #' sce <- SingleCellExperiment(assays = list(counts = rnaRaw)) #' colLabels(sce) <- rnaCluster @@ -428,7 +427,6 @@ plotQuaternary.simMat <- function( theta = 20, phi = 0 ) { - # print(colorArg) dotSize <- dotSize %||% 0.6 vertexLabelSize <- vertexLabelSize %||% 1 arrowLinewidth <- arrowLinewidth %||% 0.6 @@ -482,7 +480,6 @@ plotQuaternary.simMat <- function( colvar <- NULL col <- colorArg$colors } - # Plot data grDevices::pdf(nullfile()) scatter3D(x = cellCart[,1], y = cellCart[,2], z = cellCart[,3], @@ -885,8 +882,7 @@ writeQuaternaryGIF <- function( plotData <- do.call(plotQuaternary, c(list(x = x, returnData = TRUE), methodArgs)) clusterVar <- plotData$originalCluster - methodArgs$dotColorBy <- plotData$dotColorBy - methodArgs$dotColor <- plotData$dotColor + methodArgs$colorArg <- plotData$colorArg if (!is.null(cluster)) { if (length(cluster) != 1) cli::cli_abort("Can only generate GIF for one cluster at a time") @@ -898,6 +894,7 @@ writeQuaternaryGIF <- function( simMat <- plotData$sim[clusterVar == cluster,] veloMat <- plotData$velo[clusterVar == cluster,] if (!"title" %in% names(methodArgs)) methodArgs$title <- cluster + if ("colorArg" %in% names(methodArgs)) methodArgs$colorArg <- methodArgs$colorArg[clusterVar == cluster] } else { simMat <- plotData$sim veloMat <- plotData$velo @@ -930,7 +927,7 @@ writeQuaternaryGIF <- function( imgJoined <- magick::image_join(imgList) imgAnimated <- magick::image_animate(imgJoined, fps = fps) if (!is.null(filename)) { - filename <- normalizePath(filename, mustWork = TRUE) + filename <- normalizePath(filename, mustWork = FALSE) magick::image_write(image = imgAnimated, path = filename) cli::cli_process_done(msg_done = "GIF written to file: {.file {filename}}") diff --git a/R/util.R b/R/util.R index 4cca951..1f4f27d 100644 --- a/R/util.R +++ b/R/util.R @@ -121,7 +121,9 @@ is.rawCounts <- function(x) { mat <- SummarizedExperiment::assay(object, assay.type) clusterVar <- clusterVar %||% SingleCellExperiment::colLabels(object) - if (length(clusterVar) == 1) { + if (length(clusterVar) == 0) { + clusterVar <- NULL + } else if (length(clusterVar) == 1) { clusterVar <- SummarizedExperiment::colData(object)[[clusterVar]] } else if (length(clusterVar) != ncol(object)) { stop("Invalid `clusterVar`.") diff --git a/README.md b/README.md index 74a8e18..220b592 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # CytoSimplex -[![R_CMD_check](https://github.com/welch-lab/CytoSimplex/actions/workflows/R_CMD_check.yml/badge.svg?branch=main)](https://github.com/welch-lab/CytoSimplex/actions/workflows/R_CMD_check.yml)[![codecov](https://codecov.io/gh/mvfki/CytoSimplex/branch/main/graph/badge.svg?token=AYU2AOE25I)](https://app.codecov.io/gh/mvfki/CytoSimplex)[![Seurat](https://img.shields.io/badge/Seurat-5.0.1-blue)](https://CRAN.R-project.org/package=Seurat)[![sce](https://img.shields.io/badge/SingleCellExperiment-1.22.0-blue)](https://bioconductor.org/packages/release/bioc/html/SingleCellExperiment.html) +[![R_CMD_check](https://github.com/welch-lab/CytoSimplex/actions/workflows/R_CMD_check.yml/badge.svg?branch=main)](https://github.com/welch-lab/CytoSimplex/actions/workflows/R_CMD_check.yml)[![codecov](https://codecov.io/gh/mvfki/CytoSimplex/branch/main/graph/badge.svg?token=AYU2AOE25I)](https://app.codecov.io/gh/mvfki/CytoSimplex)[![Seurat](https://img.shields.io/badge/Seurat-5.1.0-blue)](https://CRAN.R-project.org/package=Seurat)[![sce](https://img.shields.io/badge/SingleCellExperiment-1.26.0-blue)](https://bioconductor.org/packages/release/bioc/html/SingleCellExperiment.html) [![PyPI version](https://badge.fury.io/py/CytoSimplex.svg)](https://badge.fury.io/py/CytoSimplex) @@ -34,10 +34,4 @@ We have created a [documentation website](https://welch-lab.github.io/CytoSimple If you used CytoSimplex in your work, please cite the following work: ->[Jialin Liu, Yichen Wang, Chen Li, Yichen Gu, Noriaki Ono and Joshua D. Welch, CytoSimplex: Visualizing Single-cell Fates and Transitions on a Simplex, 2023, bioRxiv](https://doi.org/10.1101/2023.12.07.570655 - - - - - - ) +>[Jialin Liu, Yichen Wang, Chen Li, Yichen Gu, Noriaki Ono and Joshua D. Welch, CytoSimplex: Visualizing Single-cell Fates and Transitions on a Simplex, 2023, bioRxiv](https://doi.org/10.1101/2023.12.07.570655) diff --git a/man/plotQuaternary.SingleCellExperiment.Rd b/man/plotQuaternary.SingleCellExperiment.Rd index caed77e..b1c843e 100644 --- a/man/plotQuaternary.SingleCellExperiment.Rd +++ b/man/plotQuaternary.SingleCellExperiment.Rd @@ -132,7 +132,7 @@ advance. Linux users may refer to this \examples{ \donttest{ # SingleCellExperiment example -if (requreNamespace("SingleCellExperiment", quietly = TRUE)) { +if (requireNamespace("SingleCellExperiment", quietly = TRUE)) { require(SingleCellExperiment) sce <- SingleCellExperiment(assays = list(counts = rnaRaw)) colLabels(sce) <- rnaCluster diff --git a/tests/testthat/test-binary.R b/tests/testthat/test-binary.R index 426b7cf..5c8c4df 100644 --- a/tests/testthat/test-binary.R +++ b/tests/testthat/test-binary.R @@ -1,5 +1,4 @@ library(testthat) -library(CytoSimplex) library(Matrix) data("rnaRaw", package = "CytoSimplex") @@ -9,7 +8,7 @@ gene <- selectTopFeatures(rnaRaw, rnaCluster, vertices) test_that("Test binary - sparse", { expect_error(plotBinary(rnaRaw, rnaCluster[1:100], c("CH", "ORT")), - "Length of `clusterVar` must match") + "Length of `clusterVar` must be 250") expect_error(plotBinary(rnaRaw, rnaCluster, "hi"), "Must specify 2 different vertices.") expect_error(plotBinary(rnaRaw, rnaCluster, c("hi", "hey")), @@ -19,7 +18,7 @@ test_that("Test binary - sparse", { expect_error(plotBinary(rnaRaw, rnaCluster, vertices), "Detected more than 500") - expect_warning(plotBinary(rnaRaw, rnaCluster, c(vertices, "CH"), features = gene), + expect_message(plotBinary(rnaRaw, rnaCluster, c(vertices, "CH"), features = gene), "2 vertices are expected while 3 are specified") rnaNorm <- colNormalize(rnaRaw) expect_warning(plotBinary(rnaNorm, rnaCluster, vertices, gene), diff --git a/tests/testthat/test-objectS3.R b/tests/testthat/test-objectS3.R index 2e16f3b..6ff278d 100644 --- a/tests/testthat/test-objectS3.R +++ b/tests/testthat/test-objectS3.R @@ -4,7 +4,6 @@ if (requireNamespace("Seurat", quietly = TRUE) && Sys.setenv("OMP_THREAD_LIMIT" = 2) library(testthat) - library(CytoSimplex) library(Matrix) data("rnaRaw", package = "CytoSimplex") @@ -81,8 +80,8 @@ if (requireNamespace("Seurat", quietly = TRUE) && gene <- selectTopFeatures(rnaRaw, rnaCluster, vertices) p1 <- plotQuaternary(srt, vertices = vertices, features = gene) p2 <- plotQuaternary(sce, vertices = vertices, features = gene) - expect_s3_class(p1, "plist") - expect_s3_class(p2, "plist") + expect_s3_class(p1, "plotly") + expect_s3_class(p2, "plotly") expect_no_warning(plotQuaternary(srt, slot = "data", vertices = vertices, features = gene)) expect_no_warning(plotQuaternary(sce, assay.type = "normcounts", diff --git a/tests/testthat/test-preprocessing.R b/tests/testthat/test-preprocessing.R index b0dc4fe..b612868 100644 --- a/tests/testthat/test-preprocessing.R +++ b/tests/testthat/test-preprocessing.R @@ -1,5 +1,4 @@ library(testthat) -library(CytoSimplex) library(Matrix) data("rnaRaw", package = "CytoSimplex") diff --git a/tests/testthat/test-quaternary.R b/tests/testthat/test-quaternary.R index fe5fba0..fc63978 100644 --- a/tests/testthat/test-quaternary.R +++ b/tests/testthat/test-quaternary.R @@ -1,5 +1,4 @@ library(testthat) -library(CytoSimplex) library(Matrix) Sys.setenv("OMP_THREAD_LIMIT" = 2) @@ -16,32 +15,31 @@ test_that("Test quaternary - sparse", { "Specified vertex clusters are not all found in the cluster ") expect_error(plotQuaternary(rnaRaw, rnaCluster, vertices, dotColor = c("a", "b")), - "`dotColor` need to be either 1") + "Length of `dotColor` must be 1 for all dots") expect_error(plotQuaternary(rnaRaw, rnaCluster, vertices, gene, veloGraph = rnaVelo[1:10,]), - "`veloGraph must be of shape N x N and has dimnames covering ") - expect_warning(plotQuaternary(rnaRaw, rnaCluster, c(vertices, "Stem"), gene), + "`veloGraph` must have dimension of 250 x 250 and has dimnames covering all") + expect_message(plotQuaternary(rnaRaw, rnaCluster, c(vertices, "Stem"), gene), "4 vertices are expected while 5 are specified.") rnaNorm <- colNormalize(rnaRaw) - expect_warning(plotQuaternary(rnaNorm, rnaCluster, vertices, gene), + expect_message(plotQuaternary(rnaNorm, rnaCluster, vertices, gene), "Input matrix is not raw counts") p <- plotQuaternary(rnaRaw, rnaCluster, vertices, gene, veloGraph = rnaVelo) - expect_s3_class(p, "plist") + expect_s3_class(p, "plotly") - pl <- plotQuaternary(rnaRaw, rnaCluster, vertices, gene, byCluster = "all") + pl <- plotQuaternary(rnaRaw, rnaCluster, vertices, gene, byCluster = "all", interactive = FALSE) expect_identical(class(pl), "list") pl <- plotQuaternary(rnaRaw, rnaCluster, vertices, gene, byCluster = "RE", - clusterTitle = FALSE) + clusterTitle = FALSE, interactive = FALSE) expect_identical(class(pl), "list") - show(p) - expect_gt(length(dev.list()), 0) + expect_no_error(show(p)) expect_error(plotQuaternary(rnaRaw, rnaCluster, vertices, gene, - byCluster = "Hi"), - "`byCluster` must be either a vector of cluster name ") + byCluster = "Hi", interactive = FALSE), + "`byCluster` must be either a vector of cluster names or just") expect_no_error(plotQuaternary(rnaRaw, rnaCluster, vertices, gene, veloGraph = rnaVelo, interactive = TRUE, title = "All cells")) @@ -50,7 +48,7 @@ test_that("Test quaternary - sparse", { test_that("Test quaternary - dense", { rnaRawSub <- as.matrix(rnaRaw[gene,]) p <- plotQuaternary(rnaRawSub, rnaCluster, vertices) - expect_s3_class(p, "plist") + expect_s3_class(p, "plotly") }) test_that("Test quaternary GIF", { @@ -67,36 +65,33 @@ test_that("Test quaternary GIF", { expect_error(writeQuaternaryGIF(rnaRaw, clusterVar = rnaCluster, vertices = grouping, features = gene, cluster = "a"), - "\"a\" is not an available cluster.") + "Specified `cluster`") expect_error(writeQuaternaryGIF(rnaRaw, clusterVar = rnaCluster, features = gene, vertices = grouping, fps = 33), - "FPS must be a factor of 100.") + "`FPS` must be a factor of 100") + skip_on_cran() - expect_warning(writeQuaternaryGIF(rnaRaw, clusterVar = rnaCluster, + tmpgif <- tempfile(pattern = "test_", fileext = ".gif") + expect_message(writeQuaternaryGIF(rnaRaw, clusterVar = rnaCluster, vertices = grouping, features = gene, - cluster = "RE", - gifPath = "test.gif", tmpDir = "testGif/", + cluster = "RE", filename = tmpgif, theta = 10), - "Arguments ignored: theta") - expect_true(dir.exists("testGif")) - expect_true(file.exists("test.gif")) - unlink("testGif/", recursive = TRUE) - unlink("test.gif") + "These arguments are ignored") + expect_true(file.exists(tmpgif)) + unlink(tmpgif) + tmpgif <- tempfile(pattern = "test2_", fileext = ".gif") writeQuaternaryGIF(rnaRaw, clusterVar = rnaCluster, vertices = grouping, features = gene, - gifPath = "test.gif", tmpDir = "testGif/") - expect_true(dir.exists("testGif")) - expect_true(file.exists("test.gif")) - unlink("testGif/", recursive = TRUE) - unlink("test.gif") + filename = tmpgif) + expect_true(file.exists(tmpgif)) + unlink(tmpgif) + tmpgif <- tempfile(pattern = "test3_", fileext = ".gif") writeQuaternaryGIF(rnaRaw, clusterVar = rnaCluster, features = gene, vertices = grouping, useCluster = "Stem", - gifPath = "test2.gif", tmpDir = "testGif2/") - expect_true(dir.exists("testGif2")) - expect_true(file.exists("test2.gif")) - unlink("testGif2/", recursive = TRUE) - unlink("test2.gif") + filename = tmpgif) + expect_true(file.exists(tmpgif)) + unlink(tmpgif) }) diff --git a/tests/testthat/test-ternary.R b/tests/testthat/test-ternary.R index 95ce3bd..f516687 100644 --- a/tests/testthat/test-ternary.R +++ b/tests/testthat/test-ternary.R @@ -1,5 +1,4 @@ library(testthat) -library(CytoSimplex) library(Matrix) data("rnaRaw", package = "CytoSimplex") @@ -15,11 +14,11 @@ test_that("Test ternary - sparse", { "Specified vertex clusters are not all found in the cluster ") expect_error(plotTernary(rnaRaw, rnaCluster, vertices, dotColor = c("a", "b")), - "`dotColor` need to be either 1") + "Length of `dotColor` must be 1 for all dots") expect_error(plotTernary(rnaRaw, rnaCluster, vertices, gene, veloGraph = rnaVelo[1:10,]), "`veloGraph must be of shape N x N and has dimnames covering ") - expect_warning(plotTernary(rnaRaw, rnaCluster, c(vertices, "ORT"), gene), + expect_message(plotTernary(rnaRaw, rnaCluster, c(vertices, "ORT"), gene), "3 vertices are expected while 4 are specified") rnaNorm <- colNormalize(rnaRaw) expect_warning(plotTernary(rnaNorm, rnaCluster, vertices, gene), diff --git a/vignettes/CytoSimplex.Rmd b/vignettes/CytoSimplex.Rmd index be4a039..b7a9ded 100644 --- a/vignettes/CytoSimplex.Rmd +++ b/vignettes/CytoSimplex.Rmd @@ -10,8 +10,6 @@ vignette: > --- ```{r setup, include=FALSE} -library(rgl) -knitr::knit_hooks$set(webgl = hook_webgl) knitr::opts_chunk$set(echo = TRUE, fig.align = 'center', message = FALSE) ``` @@ -110,20 +108,14 @@ As shown in the subplots, the OCT stem cells has the transitional potential towa For a quaternary simplex, we need one more cluster as a vertex. Here, we add the cells annotated as osteoblast-reticular transition cells (`"ORT"`) into the vertex list. We also add the velocity information in this example, as it will not be shown by default. -```{R plotQuaternary, fig.height = 4, fig.width = 4} +```{R plotQuaternary, fig.height = 4, fig.width = 6} vt.quat <- c("OS", "RE", "CH", "ORT") gene.quat <- selectTopFeatures(rnaRaw, clusterVar = rnaCluster, vertices = vt.quat) plotQuaternary(rnaRaw, clusterVar = rnaCluster, vertices = vt.quat, features = gene.quat, veloGraph = rnaVelo) ``` -To show a interactive 3D display, users can simply add the argument `interactive = TRUE`. -```{R plotQuaternaryRGL, webgl=TRUE} -plotQuaternary(rnaRaw, clusterVar = rnaCluster, vertices = vt.quat, - features = gene.quat, veloGraph = rnaVelo, interactive = TRUE) -``` - -**↑↑↑Try drag it!** +The 3D tetrahedron shown is automatically generated with an **interactive** web widget. If a static view is preferred, users can set `interactive = FALSE` in the function call, and adjust the view angle with `theta` and `phi` arguments. We have also implemented of GIF image generator that rotates the tetrahedron rounding the z-axis. Note that package `magick` is required for this feature. (See here for how to install `magick` in detail)