From 43f23725db8498e4a2f579add042352accfc0396 Mon Sep 17 00:00:00 2001 From: vincentvh Date: Tue, 16 Jan 2024 17:16:49 +0100 Subject: [PATCH 01/10] create placeholder function --- R/graph_layout_visualization.R | 202 +++++++++++++++++++++++++++++++++ 1 file changed, 202 insertions(+) diff --git a/R/graph_layout_visualization.R b/R/graph_layout_visualization.R index d07610f..7363377 100644 --- a/R/graph_layout_visualization.R +++ b/R/graph_layout_visualization.R @@ -243,3 +243,205 @@ Plot2DGraph <- function ( return(p) } + + + + + + +Plot3DGraph <- function ( + object, + cells, + marker = NULL, + assay = NULL, + layout_method = c("pmds", "wpmds", "fr", "kk", "drl"), + colors = c("lightgrey", "mistyrose", "red", "darkred"), + map_nodes = TRUE, + map_edges = FALSE, + log_scale = TRUE, + node_size = 0.5, + edge_width = 0.3, + show_Bnodes = FALSE, + ... +) { + + # Validate input parameters + stopifnot( + "'colors' must be a character vector with at least 2 colors" = + is.character(colors) && + (length(colors) > 1), + "'map_nodes' must be one of TRUE or FALSE" = + is.logical(map_nodes) && + (length(map_nodes) == 1), + "'map_edges' must be one of TRUE or FALSE" = + is.logical(map_edges) && + (length(map_edges) == 1), + "'map_nodes' and 'map_edges' cannot be deactivated at the same time" = + map_nodes || + map_edges, + "'cells' must be a non-empty character vector with cell IDs" = + is.character(cells) && + (length(cells) > 0) + ) + + if (!is.null(marker)) { + stopifnot( + "'marker' must be a character of length 1" = + is.character(marker) && + (length(marker) == 1) + ) + } + + # Check and select a layout method + layout_method <- match.arg(layout_method, choices = c("pmds", "wpmds", "fr", "kk", "drl")) + layout_method_ext <- switch (layout_method, + "fr" = "Fruchterman Reingold (fr)", + "kk" = "Kamada Kawai (kk)", + "drl" = "DrL graph layout generator (drl)", + "pmds" = "pivot MDS (pmds)" + ) + + # Use default assay if assay = NULL + if (!is.null(assay)) { + stopifnot( + "'assay' must be a character of length 1" = + is.character(assay) && + (length(assay) == 1) + ) + } else { + assay <- DefaultAssay(object) + } + + # Validate assay + cg_assay <- object[[assay]] + if (!inherits(cg_assay, what = "CellGraphAssay")) { + abort(glue("Invalid assay type '{class(cg_assay)}'. Expected a 'CellGraphAssay'")) + } + + + # Fetch component graph + component_graph <- CellGraphs(cg_assay)[[cell_id]] + + if (is.null(component_graph)) + abort(glue("Missing cellgraph for component '{cell_id}'")) + + # unpack values + graph <- component_graph@cellgraph + + # Validate marker + if (!is.null(marker)) { + if (marker == "node_type") { + stopifnot( + "marker = 'node_type' can only be used for bipartite graphs" = + attr(graph, "type") == "bipartite" + ) + } else { + if (!marker %in% colnames(component_graph@counts)) { + abort(glue("'{marker}' is missing from node count matrix ", + "for component {cell_id}")) + } + } + + layout <- component_graph@layout[[layout_method]] + if (length(graph) == 0) + abort(glue("Missing cellgraph for component '{cell_id}'")) + if (length(layout) == 0) + abort(glue("Missing layout '{layout_method}' for component '{cell_id}'")) + if (length(layout) < 3) + abort(glue("Too few dimensions for a 3D visualization of layout '{layout_method}' for component '{cell_id}'")) + + # Add node marker counts if needed + if (!is.null(marker)) { + if (marker != "node_type") { + graph <- graph %N>% + mutate(marker = component_graph@counts[, marker]) %>% + { + if (log_scale) { + mutate(., marker = log1p(marker)) + } else { + . + } + } + } + } + + # Remove B nodes if show_Bnodes=FALSE + if ((attr(graph, "type") == "bipartite") && !show_Bnodes) { + inds_keep <- (graph %>% pull(node_type)) == "A" + graph <- graph %>% + filter(node_type == "A") + layout <- layout[inds_keep, ] + } + + # Rearrange by marker + if (!is.null(marker)) { + if (marker != "node_type") { + # Rearrange layout + order <- order(graph %>% pull(marker)) + layout <- data.frame(layout, row.names = graph %>% pull(name)) + graph <- graph %>% + arrange(marker) + layout <- layout[order, ] %>% as_tibble() + } + } + + data <- list(graph = graph, layout = layout, type = attr(graph, "type"), layout_type = layout_method) + return(data) + } %>% setNames(nm = cells) + + # Create plots + plots <- lapply(names(data_list), function(nm) { + # # Visualize the graph with ggraph + # p <- data_list[[nm]]$graph %>% + # ggraph(layout = data_list[[nm]]$layout) + + # { + # # Add edges if map_edges=TRUE + # if (map_edges) { + # geom_edge_link(edge_width = edge_width) + # } + # } + + # { + # # Add nodes if map_nodes=TRUE + # if (map_nodes) { + # if (!is.null(marker)) { + # if (marker == "node_type") { + # geom_node_point(mapping = aes(color = node_type), size = node_size) + # } else { + # geom_node_point(mapping = aes(color = marker), size = node_size) + # } + # } else { + # geom_node_point(size = node_size) + # } + # } + # } + + # coord_fixed() + + # { + # if (!is.null(marker)) { + # if (marker != "node_type") { + # if (log_scale) { + # labs(title = glue("{nm}"), color = paste0(marker, "\n(log-scaled)")) + # } else { + # labs(title = glue("{nm}"), color = marker) + # } + # } else { + # labs(title = glue("{nm}")) + # } + # } + # } + + # theme_void() + + # theme(plot.title = element_text(size = 10)) + # }) + + # Wrap plots + p <- wrap_plots(plots) + if (!is.null(marker)) { + if (marker != "node_type") { + p <- p & scale_color_gradientn(colours = colors) + } + } + p <- p + plot_annotation(title = glue("Layout with {layout_method_ext}"), + theme = theme(plot.title = element_text(size = 14, face = "bold"))) + + return(p) + } + \ No newline at end of file From 5df6e2d887c655cc1c0fbe07c1753a07e1fa1a79 Mon Sep 17 00:00:00 2001 From: vincentvh Date: Thu, 18 Jan 2024 08:55:29 +0100 Subject: [PATCH 02/10] fix function --- R/graph_layout_visualization.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/graph_layout_visualization.R b/R/graph_layout_visualization.R index 7363377..93c4cf1 100644 --- a/R/graph_layout_visualization.R +++ b/R/graph_layout_visualization.R @@ -430,7 +430,8 @@ Plot3DGraph <- function ( # } + # theme_void() + # theme(plot.title = element_text(size = 10)) - # }) + }) + # Wrap plots p <- wrap_plots(plots) From a828912f6aa490566d2555a3e7ab9f1bf59ee42e Mon Sep 17 00:00:00 2001 From: vincentvh Date: Thu, 18 Jan 2024 13:52:51 +0100 Subject: [PATCH 03/10] working example --- DESCRIPTION | 3 +- NAMESPACE | 2 + R/graph_layout_visualization.R | 204 +++++++++++++++++++-------------- man/Plot3DGraph.Rd | 77 +++++++++++++ 4 files changed, 200 insertions(+), 86 deletions(-) create mode 100644 man/Plot3DGraph.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 3729f21..a873312 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -33,7 +33,8 @@ Imports: patchwork, ggraph, future.apply, - progressr + progressr, + plotly Suggests: Seurat (>= 5.0.0), spelling, diff --git a/NAMESPACE b/NAMESPACE index 86b8877..08bde36 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -80,6 +80,7 @@ export(EdgeRankPlot) export(KeepLargestComponent) export(LoadCellGraphs) export(Plot2DGraph) +export(Plot3DGraph) export(PolarizationScores) export(PolarizationScoresToAssay) export(ReadMPX_Seurat) @@ -108,6 +109,7 @@ import(dplyr) import(ggplot2) import(glue) import(patchwork) +import(plotly) import(rlang) import(tibble) import(tidygraph) diff --git a/R/graph_layout_visualization.R b/R/graph_layout_visualization.R index 93c4cf1..dfa4677 100644 --- a/R/graph_layout_visualization.R +++ b/R/graph_layout_visualization.R @@ -245,43 +245,79 @@ Plot2DGraph <- function ( } - - - - +#' Plot 3D graph layouts +#' +#' Plot a 3D component graph layout computed with \code{\link{ComputeLayout}} and +#' color nodes by a marker. +#' +#' @param object A \code{Seurat} object +#' @param cell_id ID of component to visualize +#' @param marker Name of marker to color the nodes by +#' @param assay Name of assay to pull data from +#' @param layout_method Select appropriate layout previously computed with +#' \code{\link{ComputeLayout}} +#' @param project Project the nodes onto a sphere. Default FALSE +#' @param aspectmode Set aspect ratio to one of "data", "auto" or "cube". +#' If "cube", this scene's axes are drawn as a cube, regardless of the axes' ranges. +#' If "data", this scene's axes are drawn in proportion with the axes' ranges. +#' If "auto", this scene's axes are drawn using the results of "data" except when one axis is more than four times the size of the two others, where in that case the results of "cube" are used. +#' +#' Default "data" +#' +#' @param color Color the nodes expressing a marker. Default "darkred" +#' @param log_scale Convert node counts to log-scale with \code{logp} +#' @param node_size Size of nodes +#' @param show_Bnodes Should B nodes be included in the visualization? +#' This option is only applicable to bipartite graphs. +#' @param ... Additional parameters +#' @param showgrid Show the grid lines. Default TRUE +#' +#' @rdname Plot3DGraph +#' +#' @import plotly +#' @import glue +#' @import ggplot2 +#' +#' @return A interactive 3D plot of a component graph layout as a \code{plotly} object +#' +#' @examples +#' library(pixelatorR) +#' pxl_file <- system.file("extdata/PBMC_10_cells", +#' "Sample01_test.pxl", +#' package = "pixelatorR") +#' +#' seur <- ReadMPX_Seurat(pxl_file, overwrite = TRUE) +#' seur <- LoadCellGraphs(seur, load_as = "Anode", cells = colnames(seur)[1:10]) +#' seur[["mpxCells"]] <- KeepLargestComponent(seur[["mpxCells"]]) +#' seur <- ComputeLayout(seur, layout_method = "pmds", dim = 3) +#' +#' Plot3DGraph(seur, cells = colnames(seur)[1], marker = "HLA-ABC") +#' +#' @export Plot3DGraph <- function ( object, - cells, + cell_id, marker = NULL, assay = NULL, layout_method = c("pmds", "wpmds", "fr", "kk", "drl"), - colors = c("lightgrey", "mistyrose", "red", "darkred"), - map_nodes = TRUE, - map_edges = FALSE, + project = FALSE, + aspectmode = c("data", "auto"), + color = "darkred", + showgrid = TRUE, log_scale = TRUE, - node_size = 0.5, - edge_width = 0.3, + node_size = 2, show_Bnodes = FALSE, ... ) { # Validate input parameters stopifnot( - "'colors' must be a character vector with at least 2 colors" = - is.character(colors) && - (length(colors) > 1), - "'map_nodes' must be one of TRUE or FALSE" = - is.logical(map_nodes) && - (length(map_nodes) == 1), - "'map_edges' must be one of TRUE or FALSE" = - is.logical(map_edges) && - (length(map_edges) == 1), - "'map_nodes' and 'map_edges' cannot be deactivated at the same time" = - map_nodes || - map_edges, - "'cells' must be a non-empty character vector with cell IDs" = - is.character(cells) && - (length(cells) > 0) + "'color' must be a character vector with a single color" = + is.character(color) && + (length(color) == 1), + "'cell_id' must be a non-empty character vector with a single cell ID" = + is.character(cell_id) && + (length(cell_id) == 1) ) if (!is.null(marker)) { @@ -301,6 +337,10 @@ Plot3DGraph <- function ( "pmds" = "pivot MDS (pmds)" ) + # Check and select an aspectmode + aspectmode <- match.arg(aspectmode) + + # Use default assay if assay = NULL if (!is.null(assay)) { stopifnot( @@ -322,8 +362,7 @@ Plot3DGraph <- function ( # Fetch component graph component_graph <- CellGraphs(cg_assay)[[cell_id]] - if (is.null(component_graph)) - abort(glue("Missing cellgraph for component '{cell_id}'")) + if (is.null(component_graph)) abort(glue("Missing cellgraph for component '{cell_id}'")) # unpack values graph <- component_graph@cellgraph @@ -340,7 +379,7 @@ Plot3DGraph <- function ( abort(glue("'{marker}' is missing from node count matrix ", "for component {cell_id}")) } - } + }} layout <- component_graph@layout[[layout_method]] if (length(graph) == 0) @@ -385,64 +424,59 @@ Plot3DGraph <- function ( } } - data <- list(graph = graph, layout = layout, type = attr(graph, "type"), layout_type = layout_method) - return(data) - } %>% setNames(nm = cells) - - # Create plots - plots <- lapply(names(data_list), function(nm) { - # # Visualize the graph with ggraph - # p <- data_list[[nm]]$graph %>% - # ggraph(layout = data_list[[nm]]$layout) + - # { - # # Add edges if map_edges=TRUE - # if (map_edges) { - # geom_edge_link(edge_width = edge_width) - # } - # } + - # { - # # Add nodes if map_nodes=TRUE - # if (map_nodes) { - # if (!is.null(marker)) { - # if (marker == "node_type") { - # geom_node_point(mapping = aes(color = node_type), size = node_size) - # } else { - # geom_node_point(mapping = aes(color = marker), size = node_size) - # } - # } else { - # geom_node_point(size = node_size) - # } - # } - # } + - # coord_fixed() + - # { - # if (!is.null(marker)) { - # if (marker != "node_type") { - # if (log_scale) { - # labs(title = glue("{nm}"), color = paste0(marker, "\n(log-scaled)")) - # } else { - # labs(title = glue("{nm}"), color = marker) - # } - # } else { - # labs(title = glue("{nm}")) - # } - # } - # } + - # theme_void() + - # theme(plot.title = element_text(size = 10)) - }) + data_list <- list(graph = graph, layout = layout, type = attr(graph, "type"), layout_type = layout_method) - - # Wrap plots - p <- wrap_plots(plots) - if (!is.null(marker)) { - if (marker != "node_type") { - p <- p & scale_color_gradientn(colours = colors) - } + # Create plot + plot_data <- data_list$layout %>% mutate(marker = data_list$graph %>% pull(marker)) + colorscale <- list(c(0, 1), c("lightgrey", color)) + # Plot 3D graph using plotly + if(!project){ + fig <- plotly::plot_ly(plot_data, + x = ~x, + y = ~y, + z = ~z, + marker = list(color = ~marker, + colorscale = colorscale, + showscale = TRUE, + size = node_size)) + fig <- fig %>% plotly::add_markers() %>% plotly::layout(scene = list(aspectmode=aspectmode, + xaxis = list(visible = showgrid), + yaxis = list(visible = showgrid), + zaxis = list(visible = showgrid)), + annotations = list(x = 1, + y = 0.98, + text = marker, + showarrow = FALSE)) + } else { + plot_data <- + plot_data %>% + + # Normalize 3D coordinates to a sphere + mutate(norm_factor = + select(., x, y, z) %>% + apply(MARGIN = 1, function(x) { + as.matrix(x) %>% + norm(type = "F") + }), + x_norm = x / norm_factor, + y_norm = y / norm_factor, + z_norm = z / norm_factor) + fig <- plotly::plot_ly(plot_data, + x = ~x_norm, + y = ~y_norm, + z = ~z_norm, + marker = list(color = ~marker, + colorscale = colorscale, + showscale = TRUE, + size = node_size)) + fig <- fig %>% plotly::add_markers() %>% plotly::layout(scene = list(xaxis = list(visible = showgrid), + yaxis = list(visible = showgrid), + zaxis = list(visible = showgrid)),annotations = list(x = 1, + y = 0.98, + text = marker, + showarrow = FALSE)) + warning("Projection to a sphere overrides the aspect ratio setting", call. = FALSE) } - p <- p + plot_annotation(title = glue("Layout with {layout_method_ext}"), - theme = theme(plot.title = element_text(size = 14, face = "bold"))) - - return(p) + return(fig) } \ No newline at end of file diff --git a/man/Plot3DGraph.Rd b/man/Plot3DGraph.Rd new file mode 100644 index 0000000..2e8ef1b --- /dev/null +++ b/man/Plot3DGraph.Rd @@ -0,0 +1,77 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/graph_layout_visualization.R +\name{Plot3DGraph} +\alias{Plot3DGraph} +\title{Plot 3D graph layouts} +\usage{ +Plot3DGraph( + object, + cell_id, + marker = NULL, + assay = NULL, + layout_method = c("pmds", "wpmds", "fr", "kk", "drl"), + project = FALSE, + aspectmode = c("data", "auto"), + color = "darkred", + showgrid = TRUE, + log_scale = TRUE, + node_size = 2, + show_Bnodes = FALSE, + ... +) +} +\arguments{ +\item{object}{A \code{Seurat} object} + +\item{cell_id}{ID of component to visualize} + +\item{marker}{Name of marker to color the nodes by} + +\item{assay}{Name of assay to pull data from} + +\item{layout_method}{Select appropriate layout previously computed with +\code{\link{ComputeLayout}}} + +\item{project}{Project the nodes onto a sphere. Default FALSE} + +\item{aspectmode}{Set aspect ratio to one of "data", "auto" or "cube". +If "cube", this scene's axes are drawn as a cube, regardless of the axes' ranges. +If "data", this scene's axes are drawn in proportion with the axes' ranges. +If "auto", this scene's axes are drawn using the results of "data" except when one axis is more than four times the size of the two others, where in that case the results of "cube" are used. + +Default "data"} + +\item{color}{Color the nodes expressing a marker. Default "darkred"} + +\item{showgrid}{Show the grid lines. Default TRUE} + +\item{log_scale}{Convert node counts to log-scale with \code{logp}} + +\item{node_size}{Size of nodes} + +\item{show_Bnodes}{Should B nodes be included in the visualization? +This option is only applicable to bipartite graphs.} + +\item{...}{Additional parameters} +} +\value{ +A interactive 3D plot of a component graph layout as a \code{plotly} object +} +\description{ +Plot a 3D component graph layout computed with \code{\link{ComputeLayout}} and +color nodes by a marker. +} +\examples{ +library(pixelatorR) +pxl_file <- system.file("extdata/PBMC_10_cells", + "Sample01_test.pxl", + package = "pixelatorR") + +seur <- ReadMPX_Seurat(pxl_file, overwrite = TRUE) +seur <- LoadCellGraphs(seur, load_as = "Anode", cells = colnames(seur)[1:10]) +seur[["mpxCells"]] <- KeepLargestComponent(seur[["mpxCells"]]) +seur <- ComputeLayout(seur, layout_method = "pmds", dim = 3) + +Plot3DGraph(seur, cells = colnames(seur)[1], marker = "HLA-ABC") + +} From d2c25c506e9f75347adcb21aec0fae6fea4c684e Mon Sep 17 00:00:00 2001 From: vincentvh Date: Thu, 18 Jan 2024 14:52:29 +0100 Subject: [PATCH 04/10] add test --- NAMESPACE | 2 +- R/graph_layout_visualization.R | 8 +++----- tests/testthat/test-Plot3dGraph.R | 29 +++++++++++++++++++++++++++++ 3 files changed, 33 insertions(+), 6 deletions(-) create mode 100644 tests/testthat/test-Plot3dGraph.R diff --git a/NAMESPACE b/NAMESPACE index 4d7db64..cca36b2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -81,6 +81,7 @@ export(KeepLargestComponent) export(LoadCellGraphs) export(Plot2DGraph) export(Plot2DGraphM) +export(Plot3DGraph) export(PolarizationScores) export(PolarizationScoresToAssay) export(ReadMPX_Seurat) @@ -109,7 +110,6 @@ import(dplyr) import(ggplot2) import(glue) import(patchwork) -import(plotly) import(rlang) import(tibble) import(tidygraph) diff --git a/R/graph_layout_visualization.R b/R/graph_layout_visualization.R index da42ce0..54461d0 100644 --- a/R/graph_layout_visualization.R +++ b/R/graph_layout_visualization.R @@ -517,9 +517,6 @@ Plot2DGraphM <- function ( #' #' @rdname Plot3DGraph #' -#' @import plotly -#' @import glue -#' @import ggplot2 #' #' @return A interactive 3D plot of a component graph layout as a \code{plotly} object #' @@ -714,11 +711,12 @@ Plot3DGraph <- function ( size = node_size)) fig <- fig %>% plotly::add_markers() %>% plotly::layout(scene = list(xaxis = list(visible = showgrid), yaxis = list(visible = showgrid), - zaxis = list(visible = showgrid)),annotations = list(x = 1, + zaxis = list(visible = showgrid)), + annotations = list(x = 1, y = 0.98, text = marker, showarrow = FALSE)) - warning("Projection to a sphere overrides the aspect ratio setting", call. = FALSE) + #warning("Projection to a sphere overrides the aspect ratio setting", call. = FALSE) } return(fig) } diff --git a/tests/testthat/test-Plot3dGraph.R b/tests/testthat/test-Plot3dGraph.R new file mode 100644 index 0000000..814869e --- /dev/null +++ b/tests/testthat/test-Plot3dGraph.R @@ -0,0 +1,29 @@ +pxl_file <- system.file("extdata/PBMC_10_cells", + "Sample01_test.pxl", + package = "pixelatorR") +seur_obj <- ReadMPX_Seurat(pxl_file, overwrite = TRUE) +seur_obj <- LoadCellGraphs(seur_obj, cells = colnames(seur_obj)[1:2]) +seur_obj[["mpxCells"]] <- KeepLargestComponent(seur_obj[["mpxCells"]]) +seur_obj <- ComputeLayout(seur_obj, layout_method = "pmds", dim = 3) + +test_that("Plot3DGraph works as expected", { + expect_no_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1], layout_method = "pmds", marker = "CD14")}) + expect_s3_class(layout_plot, "plotly") + expect_no_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1], layout_method = "pmds", marker = "CD14")}) + expect_equal(layout_plot$x$layoutAttrs[[1]]$annotations$text, "CD14") + + # Test with showBnodes active + expect_no_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1], layout_method = "pmds", show_Bnodes = TRUE, marker = "CD14")}) + + # Test with project active + expect_no_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1], layout_method = "pmds", project = TRUE, marker = "CD14")}) +}) + +test_that("Plot3DGraph fails with invalid input", { + expect_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1], layout_method = "invalid", marker = "CD14")}) + expect_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1])}) + expect_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1], layout_method = "pmds", color = c("blue", "red"), marker = "CD14")}, + "'color' must be a character vector with a single color") + expect_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1:2], layout_method = "pmds", node_size = 2, marker = "CD14")}, + "'cell_id' must be a non-empty character vector with a single cell ID") +}) From b063c8fdd17bc5e6f280fe9bab922314a069729a Mon Sep 17 00:00:00 2001 From: vincentvh Date: Thu, 18 Jan 2024 15:10:50 +0100 Subject: [PATCH 05/10] fix typo --- R/graph_layout_visualization.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/graph_layout_visualization.R b/R/graph_layout_visualization.R index 54461d0..0426091 100644 --- a/R/graph_layout_visualization.R +++ b/R/graph_layout_visualization.R @@ -531,7 +531,7 @@ Plot2DGraphM <- function ( #' seur[["mpxCells"]] <- KeepLargestComponent(seur[["mpxCells"]]) #' seur <- ComputeLayout(seur, layout_method = "pmds", dim = 3) #' -#' Plot3DGraph(seur, cells = colnames(seur)[1], marker = "HLA-ABC") +#' Plot3DGraph(seur, cell_id = colnames(seur)[1], marker = "HLA-ABC") #' #' @export Plot3DGraph <- function ( From b108947e0c3e4a23314a4b7feff5995d38590d9c Mon Sep 17 00:00:00 2001 From: vincentvh Date: Mon, 22 Jan 2024 14:31:41 +0100 Subject: [PATCH 06/10] Fix global val issue --- R/graph_layout_visualization.R | 2 +- man/Plot3DGraph.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/graph_layout_visualization.R b/R/graph_layout_visualization.R index 0426091..3ab17b2 100644 --- a/R/graph_layout_visualization.R +++ b/R/graph_layout_visualization.R @@ -692,7 +692,7 @@ Plot3DGraph <- function ( plot_data %>% # Normalize 3D coordinates to a sphere - mutate(norm_factor = + mutate("norm_factor" = select(., x, y, z) %>% apply(MARGIN = 1, function(x) { as.matrix(x) %>% diff --git a/man/Plot3DGraph.Rd b/man/Plot3DGraph.Rd index 2e8ef1b..b68ae5a 100644 --- a/man/Plot3DGraph.Rd +++ b/man/Plot3DGraph.Rd @@ -72,6 +72,6 @@ seur <- LoadCellGraphs(seur, load_as = "Anode", cells = colnames(seur)[1:10]) seur[["mpxCells"]] <- KeepLargestComponent(seur[["mpxCells"]]) seur <- ComputeLayout(seur, layout_method = "pmds", dim = 3) -Plot3DGraph(seur, cells = colnames(seur)[1], marker = "HLA-ABC") +Plot3DGraph(seur, cell_id = colnames(seur)[1], marker = "HLA-ABC") } From 387adfcc44df0266f7c4c82e70c11f674855716d Mon Sep 17 00:00:00 2001 From: vincentvh Date: Mon, 22 Jan 2024 14:58:13 +0100 Subject: [PATCH 07/10] add globalVariables --- R/graph_layout_visualization.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/R/graph_layout_visualization.R b/R/graph_layout_visualization.R index 3ab17b2..f8442a6 100644 --- a/R/graph_layout_visualization.R +++ b/R/graph_layout_visualization.R @@ -1,3 +1,9 @@ +globalVariables( + names = c('norm_factor'), + package = 'pixelatorR', + add = TRUE +) + #' Plot 2D graph layouts #' #' Plot 2D component graph layouts computed with \code{\link{ComputeLayout}} and @@ -692,7 +698,7 @@ Plot3DGraph <- function ( plot_data %>% # Normalize 3D coordinates to a sphere - mutate("norm_factor" = + mutate(norm_factor = select(., x, y, z) %>% apply(MARGIN = 1, function(x) { as.matrix(x) %>% From 454145ddb4942f02d10c4677e34314e42377d703 Mon Sep 17 00:00:00 2001 From: vincentvh Date: Mon, 22 Jan 2024 15:26:14 +0100 Subject: [PATCH 08/10] add plotly --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9d35f03..1ffe461 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -32,7 +32,8 @@ Imports: stringr, patchwork, ggraph, - progressr + progressr, + plotly Suggests: Seurat (>= 5.0.0), spelling, From d7d71cb100dbfe076fba9543c0fa60da1e8583e6 Mon Sep 17 00:00:00 2001 From: vincentvh Date: Tue, 23 Jan 2024 14:12:29 +0100 Subject: [PATCH 09/10] fix PR --- R/graph_layout_visualization.R | 61 +++++++++++++++++++------------ tests/testthat/test-Plot3dGraph.R | 7 ++-- 2 files changed, 41 insertions(+), 27 deletions(-) diff --git a/R/graph_layout_visualization.R b/R/graph_layout_visualization.R index 35dd573..76a11d3 100644 --- a/R/graph_layout_visualization.R +++ b/R/graph_layout_visualization.R @@ -499,14 +499,16 @@ Plot2DGraphM <- function ( #' @param layout_method Select appropriate layout previously computed with #' \code{\link{ComputeLayout}} #' @param project Project the nodes onto a sphere. Default FALSE -#' @param aspectmode Set aspect ratio to one of "data", "auto" or "cube". +#' @param aspectmode Set aspect ratio to one of "data" or "cube". #' If "cube", this scene's axes are drawn as a cube, regardless of the axes' ranges. #' If "data", this scene's axes are drawn in proportion with the axes' ranges. -#' If "auto", this scene's axes are drawn using the results of "data" except when one axis is more than four times the size of the two others, where in that case the results of "cube" are used. #' #' Default "data" #' -#' @param color Color the nodes expressing a marker. Default "darkred" +#' @param colors Color the nodes expressing a marker. Must be a character vector with two colornames. A continuous scale +#' will be created from the first color (low abundance) to the second color (high abundance). +#' @param use_palette Choose a color palette. This will override the color selection in \code{colors}. One of Greys, YlGnBu, Greens, YlOrRd, Bluered, RdBu, Reds, Blues, Picnic, Rainbow, Portland, Jet, Hot, Blackbody, Earth, Electric, Viridis, Cividis. +#' @param reversescale Reverse the color scale. Default FALSE #' @param log_scale Convert node counts to log-scale with \code{logp} #' @param node_size Size of nodes #' @param show_Bnodes Should B nodes be included in the visualization? @@ -540,8 +542,10 @@ Plot3DGraph <- function ( assay = NULL, layout_method = c("pmds", "wpmds", "fr", "kk", "drl"), project = FALSE, - aspectmode = c("data", "auto"), - color = "darkred", + aspectmode = c("data", "cube"), + colors = c("lightgrey", "darkred"), + use_palette = NULL, + reversescale = FALSE, showgrid = TRUE, log_scale = TRUE, node_size = 2, @@ -551,12 +555,16 @@ Plot3DGraph <- function ( # Validate input parameters stopifnot( - "'color' must be a character vector with a single color" = - is.character(color) && - (length(color) == 1), + "'object' must be a Seurat object" = + inherits(object, what = "Seurat"), + "'colors' must be a character vector with 2 color names" = + is.character(colors) && + (length(colors) == 2), "'cell_id' must be a non-empty character vector with a single cell ID" = is.character(cell_id) && - (length(cell_id) == 1) + (length(cell_id) == 1), + "'cell_id' must be present in the object" = + cell_id %in% colnames(object) ) if (!is.null(marker)) { @@ -568,7 +576,7 @@ Plot3DGraph <- function ( } # Check and select a layout method - layout_method <- match.arg(layout_method, choices = c("pmds", "wpmds", "fr", "kk", "drl")) + layout_method <- match.arg(layout_method) layout_method_ext <- switch (layout_method, "fr" = "Fruchterman Reingold (fr)", "kk" = "Kamada Kawai (kk)", @@ -579,7 +587,6 @@ Plot3DGraph <- function ( # Check and select an aspectmode aspectmode <- match.arg(aspectmode) - # Use default assay if assay = NULL if (!is.null(assay)) { stopifnot( @@ -597,10 +604,8 @@ Plot3DGraph <- function ( abort(glue("Invalid assay type '{class(cg_assay)}'. Expected a 'CellGraphAssay'")) } - # Fetch component graph component_graph <- CellGraphs(cg_assay)[[cell_id]] - if (is.null(component_graph)) abort(glue("Missing cellgraph for component '{cell_id}'")) # unpack values @@ -620,12 +625,14 @@ Plot3DGraph <- function ( } }} - layout <- component_graph@layout[[layout_method]] - if (length(graph) == 0) + + if (!layout_method %in% names(component_graph@layout)) + abort(glue("Missing layout '{layout_method}' for component '{cell_id}'")) + layout <- component_graph@layout[[layout_method]] + + if (length(graph) == 0) abort(glue("Missing cellgraph for component '{cell_id}'")) - if (length(layout) == 0) - abort(glue("Missing layout '{layout_method}' for component '{cell_id}'")) - if (length(layout) < 3) + if (length(layout) < 3) abort(glue("Too few dimensions for a 3D visualization of layout '{layout_method}' for component '{cell_id}'")) # Add node marker counts if needed @@ -662,12 +669,16 @@ Plot3DGraph <- function ( layout <- layout[order, ] %>% as_tibble() } } - - data_list <- list(graph = graph, layout = layout, type = attr(graph, "type"), layout_type = layout_method) + # Create colorscale, using a palette overrides the manually selected colors + if(!is.null(use_palette)){ + colorscale <- use_palette + } else { + colorscale <- list(c(0, colors[1]), c(1, colors[2])) + } + # Create plot - plot_data <- data_list$layout %>% mutate(marker = data_list$graph %>% pull(marker)) - colorscale <- list(c(0, 1), c("lightgrey", color)) + plot_data <- layout %>% mutate(marker = graph %>% pull(marker)) # Plot 3D graph using plotly if(!project){ fig <- plotly::plot_ly(plot_data, @@ -675,7 +686,8 @@ Plot3DGraph <- function ( y = ~y, z = ~z, marker = list(color = ~marker, - colorscale = colorscale, + colorscale = colorscale, + reversescale = reversescale, showscale = TRUE, size = node_size)) fig <- fig %>% plotly::add_markers() %>% plotly::layout(scene = list(aspectmode=aspectmode, @@ -705,7 +717,8 @@ Plot3DGraph <- function ( y = ~y_norm, z = ~z_norm, marker = list(color = ~marker, - colorscale = colorscale, + colorscale = colorscale, + reversescale = reversescale, showscale = TRUE, size = node_size)) fig <- fig %>% plotly::add_markers() %>% plotly::layout(scene = list(xaxis = list(visible = showgrid), diff --git a/tests/testthat/test-Plot3dGraph.R b/tests/testthat/test-Plot3dGraph.R index 814869e..00cc2f6 100644 --- a/tests/testthat/test-Plot3dGraph.R +++ b/tests/testthat/test-Plot3dGraph.R @@ -7,7 +7,8 @@ seur_obj[["mpxCells"]] <- KeepLargestComponent(seur_obj[["mpxCells"]]) seur_obj <- ComputeLayout(seur_obj, layout_method = "pmds", dim = 3) test_that("Plot3DGraph works as expected", { - expect_no_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1], layout_method = "pmds", marker = "CD14")}) + expect_no_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1], layout_method = "pmds", marker = "CD14", colors = c("blue", "red"))}) + expect_no_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1], layout_method = "pmds", marker = "CD14", colors = c("blue", "red"), use_palette = "Viridis")}) expect_s3_class(layout_plot, "plotly") expect_no_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1], layout_method = "pmds", marker = "CD14")}) expect_equal(layout_plot$x$layoutAttrs[[1]]$annotations$text, "CD14") @@ -22,8 +23,8 @@ test_that("Plot3DGraph works as expected", { test_that("Plot3DGraph fails with invalid input", { expect_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1], layout_method = "invalid", marker = "CD14")}) expect_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1])}) - expect_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1], layout_method = "pmds", color = c("blue", "red"), marker = "CD14")}, - "'color' must be a character vector with a single color") + expect_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1], layout_method = "pmds", colors = c("red"), marker = "CD14")}, + "'colors' must be a character vector with 2 color names") expect_error({layout_plot <- Plot3DGraph(seur_obj, cell_id = colnames(seur_obj)[1:2], layout_method = "pmds", node_size = 2, marker = "CD14")}, "'cell_id' must be a non-empty character vector with a single cell ID") }) From 0312ec1b10f3974d42c79f6b95754ac0f6a9b1a9 Mon Sep 17 00:00:00 2001 From: vincentvh Date: Tue, 23 Jan 2024 14:21:08 +0100 Subject: [PATCH 10/10] Fix PR --- man/Plot3DGraph.Rd | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/man/Plot3DGraph.Rd b/man/Plot3DGraph.Rd index b68ae5a..f50363e 100644 --- a/man/Plot3DGraph.Rd +++ b/man/Plot3DGraph.Rd @@ -11,8 +11,10 @@ Plot3DGraph( assay = NULL, layout_method = c("pmds", "wpmds", "fr", "kk", "drl"), project = FALSE, - aspectmode = c("data", "auto"), - color = "darkred", + aspectmode = c("data", "cube"), + colors = c("lightgrey", "darkred"), + use_palette = NULL, + reversescale = FALSE, showgrid = TRUE, log_scale = TRUE, node_size = 2, @@ -34,14 +36,18 @@ Plot3DGraph( \item{project}{Project the nodes onto a sphere. Default FALSE} -\item{aspectmode}{Set aspect ratio to one of "data", "auto" or "cube". +\item{aspectmode}{Set aspect ratio to one of "data" or "cube". If "cube", this scene's axes are drawn as a cube, regardless of the axes' ranges. If "data", this scene's axes are drawn in proportion with the axes' ranges. -If "auto", this scene's axes are drawn using the results of "data" except when one axis is more than four times the size of the two others, where in that case the results of "cube" are used. Default "data"} -\item{color}{Color the nodes expressing a marker. Default "darkred"} +\item{colors}{Color the nodes expressing a marker. Must be a character vector with two colornames. A continuous scale +will be created from the first color (low abundance) to the second color (high abundance).} + +\item{use_palette}{Choose a color palette. This will override the color selection in \code{colors}. One of Greys, YlGnBu, Greens, YlOrRd, Bluered, RdBu, Reds, Blues, Picnic, Rainbow, Portland, Jet, Hot, Blackbody, Earth, Electric, Viridis, Cividis.} + +\item{reversescale}{Reverse the color scale. Default FALSE} \item{showgrid}{Show the grid lines. Default TRUE}