Skip to content

Commit

Permalink
Disable plotVelocityStream() (#88)
Browse files Browse the repository at this point in the history 
* assign plotvelocityStream without trying to display it

* throw error from plotVelocityStream()

* version bump
  • Loading branch information
@kevinrue
kevinrue committed Sep 11, 2024
1 parent af016a7 commit 14de4ca
Show file tree
Hide file tree
Showing 5 changed files with 172 additions and 144 deletions.
6 changes: 3 additions & 3 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: velociraptor
Title: Toolkit for Single-Cell Velocity
Version: 1.15.9
Date: 2024-08-30
Version: 1.15.10
Date: 2024-09-11
Authors@R: c(person("Kevin", "Rue-Albrecht", role = c("aut", "cre"), email = "kevinrue67@gmail.com", comment = c(ORCID = "0000-0003-3899-3872")),
person("Aaron", "Lun", role="aut", email="infinite.monkeys.with.keyboards@gmail.com", comment = c(ORCID = '0000-0002-3564-4813')),
person("Charlotte", "Soneson", role="aut", email="charlottesoneson@gmail.com", comment = c(ORCID = '0000-0003-3833-2169')),
Expand Down Expand Up @@ -46,7 +46,7 @@ Suggests:
StagedInstall: no
License: MIT + file LICENSE
Encoding: UTF-8
RoxygenNote: 7.3.1
RoxygenNote: 7.3.2
URL: https://github.com/kevinrue/velociraptor
BugReports: https://github.com/kevinrue/velociraptor/issues
biocViews: SingleCell, GeneExpression, Sequencing, Coverage
Expand Down
5 changes: 5 additions & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,8 @@
# velociraptor 1.15.10

* Temporarily disable `plotVelocityStream()` due to unexplained issue related to
`metr::geom_streamline()`

# velociraptor 1.15.9

* Update Conda environment for Linux and MacOSX Arm.
Expand Down
246 changes: 129 additions & 117 deletions R/plotVelocityStream.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -67,8 +67,10 @@
#'
#' em <- embedVelocity(reducedDim(out, 1), out)[,1:2]
#'
#' \dontrun{
#' plotVelocityStream(out, em)
#' plotVelocityStream(out, em, color.streamlines = TRUE)
#' }
#'
#' @seealso \code{\link{gridVectors}} used to summarize velocity vectors into
#' a grid (velocity field), the \pkg{ggplot2} package used for plotting,
Expand All @@ -78,122 +80,132 @@
#'
#' @export
#' @importFrom S4Vectors DataFrame
plotVelocityStream <- function(sce, embedded, use.dimred = 1,
color_by = "#444444", color.alpha = 0.2,
grid.resolution = 60, scale = TRUE,
stream.L = 10, stream.min.L = 0, stream.res = 4,
stream.width = 8,
color.streamlines = FALSE,
color.streamlines.map = c("#440154", "#482576", "#414487",
"#35608D", "#2A788E", "#21908C",
"#22A884", "#43BF71", "#7AD151",
"#BBDF27", "#FDE725"),
arrow.angle = 8, arrow.length = 0.8) {
if (!identical(ncol(sce), nrow(embedded))) {
stop("'sce' and 'embedded' do not have consistent dimensions.")
plotVelocityStream <- function(
sce, embedded, use.dimred = 1,
color_by = "#444444", color.alpha = 0.2,
grid.resolution = 60, scale = TRUE,
stream.L = 10, stream.min.L = 0, stream.res = 4,
stream.width = 8,
color.streamlines = FALSE,
color.streamlines.map = c("#440154", "#482576", "#414487",
"#35608D", "#2A788E", "#21908C",
"#22A884", "#43BF71", "#7AD151",
"#BBDF27", "#FDE725"),
arrow.angle = 8, arrow.length = 0.8) {
stop(
"This function is temporarily unavailable while we investigate an issue ",
"related to metR::geom_streamline()"
)

if (!identical(ncol(sce), nrow(embedded))) {
stop("'sce' and 'embedded' do not have consistent dimensions.")
}
if (is.numeric(use.dimred)) {
stopifnot(exprs = {
identical(length(use.dimred), 1L)
use.dimred <= length(reducedDims(sce))
})
use.dimred <- reducedDimNames(sce)[use.dimred]
}
else if (is.character(use.dimred)) {
stopifnot(exprs = {
length(use.dimred) == 1L
use.dimred %in% reducedDimNames(sce)
})
}
else {
stop("'use.dimred' is not a valid value for use in reducedDim(sce, use.dimred)")
}
if (!requireNamespace("ggplot2")) {
stop("'plotVelocityStream' requires the package 'ggplot2'.")
}

# get coordinates in reduced dimensional space
xy <- reducedDim(sce, use.dimred)[, 1:2]

# summarize velocities in a grid
gr <- gridVectors(x = xy, embedded = embedded,
resolution = grid.resolution, scale = scale,
as.data.frame = FALSE,
return.intermediates = TRUE)

# now make it a regular grid needed for metR::geom_streamline
xbreaks <- seq(gr$limits[1,1], gr$limits[2,1], by = gr$delta[1])
ybreaks <- seq(gr$limits[1,2], gr$limits[2,2], by = gr$delta[2])
plotdat2 <- expand.grid(x = xbreaks + gr$delta[1] / 2,
y = ybreaks + gr$delta[2] / 2,
dx = 0, dy = 0)
allcategories <- DataFrame(expand.grid(V1 = seq(0, grid.resolution),
V2 = seq(0, grid.resolution)))
ivec <- match(gr$categories[sort(unique(gr$grp)), ], allcategories)
plotdat2[ivec, c("dx", "dy")] <- gr$vec


# plot it using ggplot2 and metR::geom_streamline
plotdat1 <- data.frame(xy)
colnames(plotdat1) <- c("x", "y")
if (is.character(color_by) && length(color_by) == 1L && color_by %in% colnames(colData(sce))) {
plotdat1 <- cbind(plotdat1, col = colData(sce)[, color_by])
colByFeat <- TRUE
} else {
colByFeat <- FALSE
}
p <- ggplot2::ggplot(plotdat1, ggplot2::aes(x = !!ggplot2::sym("x"), y = !!ggplot2::sym("y"))) +
ggplot2::labs(x = paste(use.dimred, "1"), y = paste(use.dimred, "2"))
if (!colByFeat) {
colMatrix <- grDevices::col2rgb(col = color_by, alpha = TRUE)
if (any(colMatrix[4, ] != 255)) {
warning("ignoring 'color.alpha' as 'color_by' already specifies alpha channels")
color.alpha <- colMatrix[4, ] / 255
}
if (is.numeric(use.dimred)) {
stopifnot(exprs = {
identical(length(use.dimred), 1L)
use.dimred <= length(reducedDims(sce))
})
use.dimred <- reducedDimNames(sce)[use.dimred]
}
else if (is.character(use.dimred)) {
stopifnot(exprs = {
length(use.dimred) == 1L
use.dimred %in% reducedDimNames(sce)
})
}
else {
stop("'use.dimred' is not a valid value for use in reducedDim(sce, use.dimred)")
}
if (!requireNamespace("ggplot2")) {
stop("'plotVelocityStream' requires the package 'ggplot2'.")
}

# get coordinates in reduced dimensional space
xy <- reducedDim(sce, use.dimred)[, 1:2]

# summarize velocities in a grid
gr <- gridVectors(x = xy, embedded = embedded,
resolution = grid.resolution, scale = scale,
as.data.frame = FALSE,
return.intermediates = TRUE)

# now make it a regular grid needed for metR::geom_streamline
xbreaks <- seq(gr$limits[1,1], gr$limits[2,1], by = gr$delta[1])
ybreaks <- seq(gr$limits[1,2], gr$limits[2,2], by = gr$delta[2])
plotdat2 <- expand.grid(x = xbreaks + gr$delta[1] / 2,
y = ybreaks + gr$delta[2] / 2,
dx = 0, dy = 0)
allcategories <- DataFrame(expand.grid(V1 = seq(0, grid.resolution),
V2 = seq(0, grid.resolution)))
ivec <- match(gr$categories[sort(unique(gr$grp)), ], allcategories)
plotdat2[ivec, c("dx", "dy")] <- gr$vec


# plot it using ggplot2 and metR::geom_streamline
plotdat1 <- data.frame(xy)
colnames(plotdat1) <- c("x", "y")
if (is.character(color_by) && length(color_by) == 1L && color_by %in% colnames(colData(sce))) {
plotdat1 <- cbind(plotdat1, col = colData(sce)[, color_by])
colByFeat <- TRUE
} else {
colByFeat <- FALSE
}
p <- ggplot2::ggplot(plotdat1, ggplot2::aes(x = !!ggplot2::sym("x"), y = !!ggplot2::sym("y"))) +
ggplot2::labs(x = paste(use.dimred, "1"), y = paste(use.dimred, "2"))
if (!colByFeat) {
colMatrix <- grDevices::col2rgb(col = color_by, alpha = TRUE)
if (any(colMatrix[4, ] != 255)) {
warning("ignoring 'color.alpha' as 'color_by' already specifies alpha channels")
color.alpha <- colMatrix[4, ] / 255
}
p <- p + ggplot2::geom_point(color = color_by, alpha = color.alpha)
} else {
p <- p + ggplot2::geom_point(ggplot2::aes(color = !!ggplot2::sym("col")), alpha = color.alpha) +
ggplot2::labs(color = color_by)
}
if (color.streamlines) {
# remark: when coloring streamlines, we currently cannot have any arrows
# remark: ..dx.., ..dy.. and ..step.. are calculated by metR::geom_streamline
p <- p +
metR::geom_streamline(mapping = ggplot2::aes(x = !!ggplot2::sym("x"),
y = !!ggplot2::sym("y"),
dx = !!ggplot2::sym("dx"),
dy = !!ggplot2::sym("dy"),
size = stream.width * !!ggplot2::sym("..step.."),
alpha = !!ggplot2::sym("..step.."),
color = ggplot2::stat(sqrt((!!ggplot2::sym("..dx.."))^2 +
(!!ggplot2::sym("..dy.."))^2))),
arrow = NULL, lineend = "round",
data = plotdat2, size = 0.6, jitter = 2,
L = stream.L, min.L = stream.min.L,
res = stream.res, inherit.aes = FALSE) +
ggplot2::scale_color_gradientn(colors = color.streamlines.map,
guide = "none") +
ggplot2::scale_alpha_continuous(guide = "none") +
ggplot2::theme_minimal() +
ggplot2::theme(axis.text = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank())
} else {
p <- p +
metR::geom_streamline(mapping = ggplot2::aes(x = !!ggplot2::sym("x"),
y = !!ggplot2::sym("y"),
dx = !!ggplot2::sym("dx"),
dy = !!ggplot2::sym("dy"),
size = stream.width * !!ggplot2::sym("..step..")),
data = plotdat2, size = 0.3, jitter = 2,
L = stream.L, min.L = stream.min.L,
res = stream.res, arrow.angle = arrow.angle,
arrow.length = arrow.length, inherit.aes = FALSE) +
ggplot2::theme_minimal() +
ggplot2::theme(axis.text = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank())
}

return(p)
p <- p + ggplot2::geom_point(color = color_by, alpha = color.alpha)
} else {
p <- p + ggplot2::geom_point(ggplot2::aes(color = !!ggplot2::sym("col")), alpha = color.alpha) +
ggplot2::labs(color = color_by)
}
if (color.streamlines) {
# remark: when coloring streamlines, we currently cannot have any arrows
# remark: ..dx.., ..dy.. and ..step.. are calculated by metR::geom_streamline
p <- p +
metR::geom_streamline(
mapping = ggplot2::aes(
x = !!ggplot2::sym("x"),
y = !!ggplot2::sym("y"),
dx = !!ggplot2::sym("dx"),
dy = !!ggplot2::sym("dy"),
size = stream.width * !!ggplot2::sym("..step.."),
alpha = !!ggplot2::sym("..step.."),
color = ggplot2::stat(sqrt((!!ggplot2::sym("..dx.."))^2 +
(!!ggplot2::sym("..dy.."))^2))),
arrow = NULL, lineend = "round",
data = plotdat2, size = 0.6, jitter = 2,
L = stream.L, min.L = stream.min.L,
res = stream.res, inherit.aes = FALSE) +
ggplot2::scale_color_gradientn(colors = color.streamlines.map,
guide = "none") +
ggplot2::scale_alpha_continuous(guide = "none") +
ggplot2::theme_minimal() +
ggplot2::theme(axis.text = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank())
} else {
p <- p +
metR::geom_streamline(
mapping = ggplot2::aes(
x = !!ggplot2::sym("x"),
y = !!ggplot2::sym("y"),
dx = !!ggplot2::sym("dx"),
dy = !!ggplot2::sym("dy"),
size = stream.width * !!ggplot2::sym("..step..")),
data = plotdat2, size = 0.3, jitter = 2,
L = stream.L, min.L = stream.min.L,
res = stream.res, arrow.angle = arrow.angle,
arrow.length = arrow.length, inherit.aes = FALSE) +
ggplot2::theme_minimal() +
ggplot2::theme(axis.text = ggplot2::element_blank(),
panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank())
}

return(p)
}
2 changes: 2 additions & 0 deletions man/plotVelocityStream.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

57 changes: 33 additions & 24 deletions tests/testthat/test-plotting.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,28 +66,37 @@ test_that("plotVelocity runs", {
unlink(tf)
})

test_that("plotVelocityStream runs", {

skip_if_not_installed("ggplot2")
skip_if_not_installed("metR")

expect_error(plotVelocityStream("error", em2))
expect_error(plotVelocityStream(out2, "error"))
expect_error(plotVelocityStream(out2, em2[1:10, ]))
expect_error(plotVelocityStream(out2, em2, use.dimred = "error"))
expect_error(plotVelocityStream(out2, em2, use.dimred = FALSE))
expect_error(plotVelocityStream(out2, em2, color_by = "error"))
expect_error(plotVelocityStream(out2, em2, grid.resolution = "error"))
expect_error(plotVelocityStream(out2, em2, scale = "error"))
expect_error(plotVelocityStream(out2, em2, color.streamlines = "error"))

tf <- tempfile(fileext = ".png")
png(tf)
expect_warning(print(plotVelocityStream(out2, em2, color_by = "#44444422")))
print(plotVelocityStream(out2, em2))
print(plotVelocityStream(out3, em2, color_by = "type"))
print(plotVelocityStream(out2, em2, color.streamlines = TRUE))
dev.off()
expect_true(file.exists(tf))
unlink(tf)
test_that("plotVelocityStream throws an error", {

expect_error(
plotVelocityStream(out2, em2),
"temporarily"
)

})

# test_that("plotVelocityStream runs", {
#
# skip_if_not_installed("ggplot2")
# skip_if_not_installed("metR")
#
# expect_error(plotVelocityStream("error", em2))
# expect_error(plotVelocityStream(out2, "error"))
# expect_error(plotVelocityStream(out2, em2[1:10, ]))
# expect_error(plotVelocityStream(out2, em2, use.dimred = "error"))
# expect_error(plotVelocityStream(out2, em2, use.dimred = FALSE))
# expect_error(plotVelocityStream(out2, em2, color_by = "error"))
# expect_error(plotVelocityStream(out2, em2, grid.resolution = "error"))
# expect_error(plotVelocityStream(out2, em2, scale = "error"))
# expect_error(plotVelocityStream(out2, em2, color.streamlines = "error"))
#
# tf <- tempfile(fileext = ".png")
# png(tf)
# expect_warning(print(plotVelocityStream(out2, em2, color_by = "#44444422")))
# print(plotVelocityStream(out2, em2))
# print(plotVelocityStream(out3, em2, color_by = "type"))
# print(plotVelocityStream(out2, em2, color.streamlines = TRUE))
# dev.off()
# expect_true(file.exists(tf))
# unlink(tf)
# })

0 comments on commit 14de4ca

Please sign in to comment.