Fix for Checks

welch-lab · Sep 17, 2024 · bbfb156 · bbfb156
1 parent 7e89f55
commit bbfb156
Show file tree

Hide file tree

Showing 10 changed files with 46 additions and 70 deletions.
diff --git 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
@@ -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
@@ -1,6 +1,6 @@
 # CytoSimplex <img src="man/figures/logo.png" align="right" width="120" />
 
-[![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
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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. (<a href="https://cran.r-project.org/package=magick/vignettes/intro.html#Installing_magick" target="_blank">See here for how to install `magick` in detail</a>)