Skip to content

Commit

Permalink
throw error from plotVelocityStream()
Browse files Browse the repository at this point in the history
  • Loading branch information
@kevinrue
kevinrue committed Sep 11, 2024
1 parent 11013f4 commit e5d90cf
Show file tree
Hide file tree
Showing 3 changed files with 168 additions and 145 deletions.
250 changes: 131 additions & 119 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]
#'
#' p <- plotVelocityStream(out, em)
#' p <- plotVelocityStream(out, em, color.streamlines = TRUE)
#' \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)
}
6 changes: 4 additions & 2 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(p <- plotVelocityStream("error", em2))
expect_error(p <- plotVelocityStream(out2, "error"))
expect_error(p <- plotVelocityStream(out2, em2[1:10, ]))
expect_error(p <- plotVelocityStream(out2, em2, use.dimred = "error"))
expect_error(p <- plotVelocityStream(out2, em2, use.dimred = FALSE))
expect_error(p <- plotVelocityStream(out2, em2, color_by = "error"))
expect_error(p <- plotVelocityStream(out2, em2, grid.resolution = "error"))
expect_error(p <- plotVelocityStream(out2, em2, scale = "error"))
expect_error(p <- plotVelocityStream(out2, em2, color.streamlines = "error"))

# tf <- tempfile(fileext = ".png")
# png(tf)
# expect_warning(print(p <- 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 e5d90cf

Please sign in to comment.