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, diff --git a/NAMESPACE b/NAMESPACE index d11b45b..74e42b0 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) diff --git a/R/graph_layout_visualization.R b/R/graph_layout_visualization.R index e4bc702..76a11d3 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 @@ -479,3 +485,251 @@ Plot2DGraphM <- function ( else leg <- NULL leg } + + +#' 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" 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. +#' +#' Default "data" +#' +#' @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? +#' This option is only applicable to bipartite graphs. +#' @param ... Additional parameters +#' @param showgrid Show the grid lines. Default TRUE +#' +#' @rdname Plot3DGraph +#' +#' +#' @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, cell_id = colnames(seur)[1], marker = "HLA-ABC") +#' +#' @export +Plot3DGraph <- function ( + object, + cell_id, + marker = NULL, + assay = NULL, + layout_method = c("pmds", "wpmds", "fr", "kk", "drl"), + project = FALSE, + aspectmode = c("data", "cube"), + colors = c("lightgrey", "darkred"), + use_palette = NULL, + reversescale = FALSE, + showgrid = TRUE, + log_scale = TRUE, + node_size = 2, + show_Bnodes = FALSE, + ... +) { + + # Validate input parameters + stopifnot( + "'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), + "'cell_id' must be present in the object" = + cell_id %in% colnames(object) + ) + + 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) + layout_method_ext <- switch (layout_method, + "fr" = "Fruchterman Reingold (fr)", + "kk" = "Kamada Kawai (kk)", + "drl" = "DrL graph layout generator (drl)", + "pmds" = "pivot MDS (pmds)" + ) + + # Check and select an aspectmode + aspectmode <- match.arg(aspectmode) + + # 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}")) + } + }} + + + 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) < 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() + } + } + + # 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 <- layout %>% mutate(marker = graph %>% pull(marker)) + # 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, + reversescale = reversescale, + 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, + reversescale = reversescale, + 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) + } + return(fig) + } + \ No newline at end of file diff --git a/man/Plot3DGraph.Rd b/man/Plot3DGraph.Rd new file mode 100644 index 0000000..f50363e --- /dev/null +++ b/man/Plot3DGraph.Rd @@ -0,0 +1,83 @@ +% 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", "cube"), + colors = c("lightgrey", "darkred"), + use_palette = NULL, + reversescale = FALSE, + 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" 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. + +Default "data"} + +\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} + +\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, cell_id = colnames(seur)[1], marker = "HLA-ABC") + +} diff --git a/tests/testthat/test-Plot3dGraph.R b/tests/testthat/test-Plot3dGraph.R new file mode 100644 index 0000000..00cc2f6 --- /dev/null +++ b/tests/testthat/test-Plot3dGraph.R @@ -0,0 +1,30 @@ +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", 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") + + # 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", 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") +})