diff --git a/DESCRIPTION b/DESCRIPTION index 6f46909e..8dc33161 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: spatialLIBD Title: spatialLIBD: an R/Bioconductor package to visualize spatially-resolved transcriptomics data -Version: 1.23.2 -Date: 2026-01-09 +Version: 1.25.1 +Date: 2026-05-20 Authors@R: c( person("Leonardo", "Collado-Torres", role = c("aut", "cre"), diff --git a/NAMESPACE b/NAMESPACE index 68a61fe9..bad76dfe 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -40,8 +40,10 @@ export(sig_genes_extract) export(sig_genes_extract_all) export(sort_clusters) export(vis_clus) +export(vis_clus_c) export(vis_clus_p) export(vis_gene) +export(vis_gene_c) export(vis_gene_p) export(vis_grid_clus) export(vis_grid_gene) diff --git a/NEWS.md b/NEWS.md index 16ae1187..64e0d049 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,17 @@ +# spatialLIBD 1.25.1 + +NEW FEATURES + +* `fetch_data()` now has example Xenium data you can access +with `type = "spe_xenium_example"`. +* `vis_gene()`, `vis_gene_grid()`, `vis_clus()`, `vis_clus_grid()` +all now support Xenium data. This is partially done through the +new internal functions `vis_gene_c()` and `vis_clus_c()`. +* `run_app()` now supports Xenium data. So `shiny`-powered +apps can now be built for Xenium (10x Genomics) data. +* These features were added by @lahuuki and @lcolladotor +as part of . + # spatialLIBD 1.23.2 NEW FEATURES diff --git a/R/app_server.R b/R/app_server.R index fe432807..62ee8ae5 100644 --- a/R/app_server.R +++ b/R/app_server.R @@ -26,6 +26,7 @@ app_server <- function(input, output, session) { sig_genes <- golem::get_golem_options("sig_genes") default_cluster <- golem::get_golem_options("default_cluster") is_stitched <- golem::get_golem_options("is_stitched") + datatype <- golem::get_golem_options("datatype") # List the first level callModules here @@ -178,9 +179,10 @@ app_server <- function(input, output, session) { auto_crop = input$auto_crop, is_stitched = is_stitched, guide_point_size = input$guidepointsize, + datatype = datatype, ... = paste(" with", input$cluster) ) - if (!input$side_by_side_histology) { + if (!input$side_by_side_histology || datatype == "Xenium") { return(p) } else { p_no_spots <- p @@ -220,6 +222,7 @@ app_server <- function(input, output, session) { auto_crop = isolate(input$auto_crop), is_stitched = is_stitched, guide_point_size = isolate(input$guidepointsize), + datatype = datatype, ... = paste(" with", isolate(input$cluster)) ) cowplot::plot_grid( @@ -246,9 +249,10 @@ app_server <- function(input, output, session) { point_size = input$pointsize, auto_crop = input$auto_crop, is_stitched = is_stitched, - cap_percentile = input$cap_percentile + cap_percentile = input$cap_percentile, + datatype = datatype ) - if (!input$side_by_side_gene) { + if (!input$side_by_side_gene | datatype == "Xenium") { p_result <- p } else { p_no_spots <- p @@ -297,7 +301,8 @@ app_server <- function(input, output, session) { sample_order = isolate(input$gene_grid_samples), auto_crop = isolate(input$auto_crop), is_stitched = is_stitched, - cap_percentile = isolate(input$cap_percentile) + cap_percentile = isolate(input$cap_percentile), + datatype = datatype ) }, warning = function(w) { @@ -661,32 +666,40 @@ app_server <- function(input, output, session) { # reduced_name <- 'TSNE_perplexity50' # genecolor <- "viridis" - ## Read in the histology image - img <- - SpatialExperiment::imgRaster( - spe, - sample_id = sampleid, - image_id = input$imageid - ) - if (input$auto_crop) { - frame_lims <- - frame_limits(spe, sampleid = sampleid, image_id = input$imageid) - img <- - img[ - frame_lims$y_min:frame_lims$y_max, - frame_lims$x_min:frame_lims$x_max - ] - } - ## From vis_gene() in global.R spe_sub <- spe[, spe$sample_id == sampleid] point_size <- input$pointsize - if (is_stitched) { - # Drop excluded spots and calculate an appropriate point size - temp <- prep_stitched_data(spe_sub, point_size, input$imageid) - spe_sub <- temp$spe - point_size <- temp$point_size + + ## Interactive for Visium + if (datatype == "Visium") { + ## Read in the histology image + img <- + SpatialExperiment::imgRaster( + spe_sub, + sample_id = sampleid, + image_id = input$imageid + ) + if (input$auto_crop) { + frame_lims <- + frame_limits( + spe_sub, + sampleid = sampleid, + image_id = input$imageid + ) + img <- + img[ + frame_lims$y_min:frame_lims$y_max, + frame_lims$x_min:frame_lims$x_max + ] + } + + if (is_stitched) { + # Drop excluded spots and calculate an appropriate point size + temp <- prep_stitched_data(spe_sub, point_size, input$imageid) + spe_sub <- temp$spe + point_size <- temp$point_size + } } d <- @@ -707,7 +720,9 @@ app_server <- function(input, output, session) { # Get the integer indices of each gene in the SpatialExperiment, since we # aren't guaranteed that rownames are gene names - remaining_geneid <- geneid[!(geneid %in% colnames(colData(spe_sub)))] + remaining_geneid <- geneid[ + !(geneid %in% colnames(colData(spe_sub))) + ] valid_gene_indices <- unique( c( match(remaining_geneid, rowData(spe_sub)$gene_search), @@ -750,7 +765,11 @@ app_server <- function(input, output, session) { plot_title <- paste(sampleid, "Z-score min > ", minCount) } else if (input$multi_gene_method == "sparsity") { d$COUNT <- multi_gene_sparsity(cont_matrix) - plot_title <- paste(sampleid, "Prop. nonzero min > ", minCount) + plot_title <- paste( + sampleid, + "Prop. nonzero min > ", + minCount + ) } else { # must be 'pca' d$COUNT <- multi_gene_pca(cont_matrix) @@ -762,7 +781,9 @@ app_server <- function(input, output, session) { if (input$cap_percentile < 1) { sorted_count <- sort(d$COUNT) cap <- sorted_count[ - as.integer(round(length(sorted_count) * input$cap_percentile)) + as.integer(round( + length(sorted_count) * input$cap_percentile + )) ] d$COUNT[d$COUNT > cap] <- cap } @@ -783,41 +804,72 @@ app_server <- function(input, output, session) { ## Use client-side highlighting d_key <- highlight_key(d, ~key) - ## Make the cluster plot - p_clus <- vis_clus_p( - spe = spe, - d = d_key, - clustervar = clustervar, - sampleid = sampleid, - colors = get_colors(colors, d[, clustervar]), - spatial = FALSE, - title = plot_title, - image_id = input$imageid, - alpha = input$alphalevel, - point_size = point_size, - auto_crop = input$auto_crop - ) + if (datatype == "Visium") { + ## Make the cluster plot + p_clus <- vis_clus_p( + spe = spe_sub, + d = d_key, + clustervar = clustervar, + sampleid = sampleid, + colors = get_colors(colors, d[, clustervar]), + spatial = FALSE, + title = plot_title, + image_id = input$imageid, + alpha = input$alphalevel, + point_size = point_size, + auto_crop = input$auto_crop + ) - ## Next the gene plot - p_gene <- vis_gene_p( - spe = spe, - d = d_key, - sampleid = sampleid, - spatial = FALSE, - title = "", - cont_colors = cont_colors(), - image_id = input$imageid, - alpha = input$alphalevel, - point_size = point_size, - auto_crop = input$auto_crop - ) + - geom_point( - shape = 21, - size = point_size, - stroke = 0, - alpha = input$alphalevel + ## Next the gene plot + p_gene <- vis_gene_p( + spe = spe_sub, + d = d_key, + sampleid = sampleid, + spatial = FALSE, + title = "", + cont_colors = cont_colors(), + image_id = input$imageid, + alpha = input$alphalevel, + point_size = point_size, + auto_crop = input$auto_crop + ) + + geom_point( + shape = 21, + size = point_size, + stroke = 0, + alpha = input$alphalevel + ) + } else if (datatype == "Xenium") { + ## Make the cluster plot + p_clus <- vis_clus_c( + spe = spe_sub, + d = d_key, + clustervar = clustervar, + sampleid = sampleid, + title = plot_title, + colors = get_colors(colors, d[, clustervar]), + alpha = input$alphalevel, + point_size = point_size ) + ## Next the gene plot + p_gene <- vis_gene_c( + spe = spe_sub, + d = d_key, + sampleid = sampleid, + title = "", + alpha = input$alphalevel, + cont_colors = cont_colors(), + point_size = point_size + ) + + geom_point( + shape = 21, + size = point_size, + stroke = 0, + alpha = input$alphalevel + ) + } + ## Make the reduced dimensions ggplot if (reduced_name != "") { p_dim <- ggplot( @@ -837,7 +889,9 @@ app_server <- function(input, output, session) { scale_fill_manual( values = get_colors( colors, - colData(spe)[[clustervar]][spe$sample_id == sampleid] + colData(spe)[[clustervar]][ + spe$sample_id == sampleid + ] ) ) + guides(fill = "none") + @@ -905,22 +959,26 @@ app_server <- function(input, output, session) { source = "plotly_histology", tooltip = c("fill", "key") ), - images = list( + images = if (datatype == "Xenium") { + NULL + } else { list( - source = raster2uri(img), - layer = "below", - xanchor = "left", - yanchor = "bottom", - xref = "x", - yref = "y", - sizing = "stretch", - x = 0, - y = -nrow(img), - sizex = ncol(img), - sizey = nrow(img), - opacity = 0.8 + list( + source = raster2uri(img), + layer = "below", + xanchor = "left", + yanchor = "bottom", + xref = "x", + yref = "y", + sizing = "stretch", + x = 0, + y = -nrow(img), + sizex = ncol(img), + sizey = nrow(img), + opacity = 0.8 + ) ) - ), + }, dragmode = "lasso" ) @@ -930,22 +988,26 @@ app_server <- function(input, output, session) { source = "plotly_histology", tooltip = c("fill", "key") ), - images = list( + images = if (datatype == "Xenium") { + NULL + } else { list( - source = raster2uri(img), - layer = "below", - xanchor = "left", - yanchor = "bottom", - xref = "x", - yref = "y", - sizing = "stretch", - x = 0, - y = -nrow(img), - sizex = ncol(img), - sizey = nrow(img), - opacity = 0.8 + list( + source = raster2uri(img), + layer = "below", + xanchor = "left", + yanchor = "bottom", + xref = "x", + yref = "y", + sizing = "stretch", + x = 0, + y = -nrow(img), + sizex = ncol(img), + sizey = nrow(img), + opacity = 0.8 + ) ) - ), + }, dragmode = "lasso" ) @@ -1064,7 +1126,8 @@ app_server <- function(input, output, session) { point_size = input$pointsize, auto_crop = input$auto_crop, is_stitched = is_stitched, - cap_percentile = input$cap_percentile + cap_percentile = input$cap_percentile, + datatype = datatype ) + geom_point( shape = 21, @@ -1076,25 +1139,27 @@ app_server <- function(input, output, session) { ## Update the reactiveValues data rv$ContCount <- p$data[, c("key", "COUNT")] - ## Read in the histology image - img <- - SpatialExperiment::imgRaster( - spe, - sample_id = input$sample, - image_id = input$imageid - ) - if (input$auto_crop) { - frame_lims <- - frame_limits( + if (datatype == "Visium") { + ## Read in the histology image + img <- + SpatialExperiment::imgRaster( spe, - sampleid = input$sample, + sample_id = input$sample, image_id = input$imageid ) - img <- - img[ - frame_lims$y_min:frame_lims$y_max, - frame_lims$x_min:frame_lims$x_max - ] + if (input$auto_crop) { + frame_lims <- + frame_limits( + spe, + sampleid = input$sample, + image_id = input$imageid + ) + img <- + img[ + frame_lims$y_min:frame_lims$y_max, + frame_lims$x_min:frame_lims$x_max + ] + } } suppressMessages(suppressWarnings(toWebGL( @@ -1106,22 +1171,26 @@ app_server <- function(input, output, session) { source = "plotly_gene", tooltip = c("fill", "key") ), - images = list( + images = if (datatype == "Xenium") { + NULL + } else { list( - source = raster2uri(img), - layer = "below", - xanchor = "left", - yanchor = "bottom", - xref = "x", - yref = "y", - sizing = "stretch", - x = 0, - y = -nrow(img), - sizex = ncol(img), - sizey = nrow(img), - opacity = 0.8 + list( + source = raster2uri(img), + layer = "below", + xanchor = "left", + yanchor = "bottom", + xref = "x", + yref = "y", + sizing = "stretch", + x = 0, + y = -nrow(img), + sizex = ncol(img), + sizey = nrow(img), + opacity = 0.8 + ) ) - ), + }, dragmode = "lasso" ) ))) diff --git a/R/app_ui.R b/R/app_ui.R index e88763d1..ca4e663f 100644 --- a/R/app_ui.R +++ b/R/app_ui.R @@ -15,6 +15,7 @@ app_ui <- function() { modeling_results <- golem::get_golem_options("modeling_results") sig_genes <- golem::get_golem_options("sig_genes") auto_crop_default <- golem::get_golem_options("auto_crop_default") + datatype <- golem::get_golem_options("datatype") red_dim_names <- reducedDimNames(spe) if (length(red_dim_names) > 0) { @@ -68,7 +69,11 @@ app_ui <- function() { inputId = "imageid", label = "Image name", choices = c( - "edited_imaged", + if (datatype == "Xenium") { + NULL + } else { + "edited_imaged" + }, unique(imgData(spe)$image_id) ), selected = unique(imgData(spe)$image_id)[1] @@ -565,183 +570,187 @@ app_ui <- function() { tags$br(), tags$br() ), - tabPanel( - "Edit image", - helpText( - "Edit the selected image by manipulating the colors and apperance, which can be useful when inspecting the selected image from the left menu ('image name'). Once you have a set of edits you like, click the 'update custom image' button below to save your edits. Next, select on the left menu ('image name') the 'edited_image' option to use your new image as the background image in the rest of the visualizations. Most of these image manipulations are explained at", - HTML( - "the magick R package documentation." - ) - ), - helpText( - "If you want a uniform colored background, set the brightness to 0 which will make it black, then either proceeed or select the 'negate' checkbox for white, click the 'edit custom image' button, and select the input 'image name' as 'edited image'. Instead of using 'negate' you could use 'transparent (color)' and type 'black' then under 'background (color)' type a valid R color name such as 'purple' or 'lightblue' or a color HEX value such as '#e1eb34'." - ), - hr(), - fluidRow( - column( - width = 4, - selectInput( - inputId = "editImg_channel", - label = "Select an image channel such as 'Red' or 'Blue'", - choices = c( - "", - magick::channel_types() - ), - selected = "" - ), - helpText( - "Leave this empty if you don't want to select a channel. Note that the definition of channel here is different from a multi-channel image from say VisiumIF." - ), - hr(), - numericInput( - "editImg_brightness", - label = "Image brightness level", - value = 100, - min = 0, - max = 100 - ), - numericInput( - "editImg_saturation", - label = "Image saturation level", - value = 100, - min = 0, - max = 100 - ), - numericInput( - "editImg_hue", - label = "Image hue level", - value = 100, - min = 0, - max = 200 - ), - helpText( - "Modulate the colors in the image. Brightness and saturation are in percents while hue has a range of 0 to 200. Use 100 for all 3 options for no change." + if (datatype == "Xenium") { + NULL + } else { + tabPanel( + "Edit image", + helpText( + "Edit the selected image by manipulating the colors and apperance, which can be useful when inspecting the selected image from the left menu ('image name'). Once you have a set of edits you like, click the 'update custom image' button below to save your edits. Next, select on the left menu ('image name') the 'edited_image' option to use your new image as the background image in the rest of the visualizations. Most of these image manipulations are explained at", + HTML( + "the magick R package documentation." ) ), - column( - width = 4, - checkboxInput( - "editImg_enhance", - "enhance: attempt to minimize noise", - value = FALSE - ), - checkboxInput( - "editImg_normalize", - "normalize: increases contrast by normalizing the pixel values to span the full range of colors", - value = FALSE - ), - hr(), - numericInput( - "editImg_contrast_sharpen", - label = "contrast (sharpen): enhance intensity differences in image", - value = NA, - min = -100, - max = 100 - ), - helpText( - "Try with 1 to start with." - ), - hr(), - numericInput( - "editImg_quantize_max", - label = "quantize (max): reduce number of colors in the image", - value = NA, - min = 1 - ), - checkboxInput( - "editImg_quantize_dither", - "quantize (dither): whether to apply Floyd/Steinberg error diffusion to the image: averages intensities of several neighboring pixels", - value = TRUE - ), - helpText( - "You could try 256 colors or a much small number like 25 or 40." - ) + helpText( + "If you want a uniform colored background, set the brightness to 0 which will make it black, then either proceeed or select the 'negate' checkbox for white, click the 'edit custom image' button, and select the input 'image name' as 'edited image'. Instead of using 'negate' you could use 'transparent (color)' and type 'black' then under 'background (color)' type a valid R color name such as 'purple' or 'lightblue' or a color HEX value such as '#e1eb34'." ), - column( - width = 4, - checkboxInput( - "editImg_equalize", - "equalize: whether to use histogram equalization", - value = FALSE - ), - hr(), - textInput( - "editImg_transparent_color", - label = "transparent (color): set pixels approximately matching given color", - value = NA - ), - numericInput( - "editImg_transparent_fuzz", - label = "transparent (fuzz): relative color distance (value between 0 and 100) to be considered similar", - value = 0, - min = 0, - max = 100 - ), - helpText( - "Type 'purple' and select a fuzz of 25 to start with." - ), - textInput( - "editImg_background_color", - label = "background (color): sets background color", - value = NA - ), - hr(), - numericInput( - "editImg_median_radius", - label = "median (radius): replace each pixel with the median color in a circular neighborhood", - value = NA, - min = 0 + hr(), + fluidRow( + column( + width = 4, + selectInput( + inputId = "editImg_channel", + label = "Select an image channel such as 'Red' or 'Blue'", + choices = c( + "", + magick::channel_types() + ), + selected = "" + ), + helpText( + "Leave this empty if you don't want to select a channel. Note that the definition of channel here is different from a multi-channel image from say VisiumIF." + ), + hr(), + numericInput( + "editImg_brightness", + label = "Image brightness level", + value = 100, + min = 0, + max = 100 + ), + numericInput( + "editImg_saturation", + label = "Image saturation level", + value = 100, + min = 0, + max = 100 + ), + numericInput( + "editImg_hue", + label = "Image hue level", + value = 100, + min = 0, + max = 200 + ), + helpText( + "Modulate the colors in the image. Brightness and saturation are in percents while hue has a range of 0 to 200. Use 100 for all 3 options for no change." + ) ), - helpText( - "Choose a small radius, like 1 or 2 to start. The higher the value, the longer this computation will take." + column( + width = 4, + checkboxInput( + "editImg_enhance", + "enhance: attempt to minimize noise", + value = FALSE + ), + checkboxInput( + "editImg_normalize", + "normalize: increases contrast by normalizing the pixel values to span the full range of colors", + value = FALSE + ), + hr(), + numericInput( + "editImg_contrast_sharpen", + label = "contrast (sharpen): enhance intensity differences in image", + value = NA, + min = -100, + max = 100 + ), + helpText( + "Try with 1 to start with." + ), + hr(), + numericInput( + "editImg_quantize_max", + label = "quantize (max): reduce number of colors in the image", + value = NA, + min = 1 + ), + checkboxInput( + "editImg_quantize_dither", + "quantize (dither): whether to apply Floyd/Steinberg error diffusion to the image: averages intensities of several neighboring pixels", + value = TRUE + ), + helpText( + "You could try 256 colors or a much small number like 25 or 40." + ) ), - hr(), - checkboxInput( - "editImg_negate", - "negate: whether to negate colors", - value = FALSE + column( + width = 4, + checkboxInput( + "editImg_equalize", + "equalize: whether to use histogram equalization", + value = FALSE + ), + hr(), + textInput( + "editImg_transparent_color", + label = "transparent (color): set pixels approximately matching given color", + value = NA + ), + numericInput( + "editImg_transparent_fuzz", + label = "transparent (fuzz): relative color distance (value between 0 and 100) to be considered similar", + value = 0, + min = 0, + max = 100 + ), + helpText( + "Type 'purple' and select a fuzz of 25 to start with." + ), + textInput( + "editImg_background_color", + label = "background (color): sets background color", + value = NA + ), + hr(), + numericInput( + "editImg_median_radius", + label = "median (radius): replace each pixel with the median color in a circular neighborhood", + value = NA, + min = 0 + ), + helpText( + "Choose a small radius, like 1 or 2 to start. The higher the value, the longer this computation will take." + ), + hr(), + checkboxInput( + "editImg_negate", + "negate: whether to negate colors", + value = FALSE + ) ) + ), + actionButton( + "editImg_reset_menus", + label = "Reset menus" + ), + helpText( + "Reset all image editing menus to their default values." + ), + hr(), + downloadButton( + "downloadPlotEditImg", + "Download PDF" + ), + plotOutput("editImg_plot"), + tags$br(), + tags$br(), + tags$br(), + tags$br(), + tags$br(), + tags$br(), + tags$br(), + tags$br(), + tags$br(), + tags$br(), + actionButton( + "editImg_update", + label = "Update custom image" + ), + helpText( + "Click the 'upgrade custom image' button above to save the custom image. You can then select 'edited_image' and use it in other parts of the web application. Note that if you had 'edited_image' already selected, you'll need to re-select or change another input to update the other plots." + ), + checkboxInput( + "editImg_overwrite", + "Whether to overwrite the 'edited_image'", + value = FALSE + ), + helpText( + "Select if you want to do sequential image manipulations when you have selected as input the 'edited_image'." ) - ), - actionButton( - "editImg_reset_menus", - label = "Reset menus" - ), - helpText( - "Reset all image editing menus to their default values." - ), - hr(), - downloadButton( - "downloadPlotEditImg", - "Download PDF" - ), - plotOutput("editImg_plot"), - tags$br(), - tags$br(), - tags$br(), - tags$br(), - tags$br(), - tags$br(), - tags$br(), - tags$br(), - tags$br(), - tags$br(), - actionButton( - "editImg_update", - label = "Update custom image" - ), - helpText( - "Click the 'upgrade custom image' button above to save the custom image. You can then select 'edited_image' and use it in other parts of the web application. Note that if you had 'edited_image' already selected, you'll need to re-select or change another input to update the other plots." - ), - checkboxInput( - "editImg_overwrite", - "Whether to overwrite the 'edited_image'", - value = FALSE - ), - helpText( - "Select if you want to do sequential image manipulations when you have selected as input the 'edited_image'." ) - ) + } ) ) ) diff --git a/R/check_spe.R b/R/check_spe.R index 47de3c0a..d4056782 100644 --- a/R/check_spe.R +++ b/R/check_spe.R @@ -31,18 +31,27 @@ check_spe <- function(spe, "sum_gene", "expr_chrM", "expr_chrM_ratio" - )) { + ), + datatype = c("Visium", "Xenium") + ) { ## Should be a SpatialExperiment object stopifnot(is(spe, "SpatialExperiment")) - + + ## Check for valid datatype + datatype <- match.arg(datatype) + + if(datatype == "Visium"){ + ## Images data stored under imgData(sce) stopifnot(all(c( - "sample_id", "image_id", "data", - "scaleFactor" + "sample_id", "image_id", "data", + "scaleFactor" ) %in% colnames(imgData(spe)))) - + ## Check that the images have been loaded stopifnot(all(vapply(imgData(spe)$data, is, logical(1), "VirtualSpatialImage"))) + + } ## Check gene data stopifnot(all( diff --git a/R/fetch_data.R b/R/fetch_data.R index 76bfa185..a57e02a2 100644 --- a/R/fetch_data.R +++ b/R/fetch_data.R @@ -157,7 +157,8 @@ fetch_data <- "LFF_spatial_ERC_snRNAseq_pseudobulk_broad", "LFF_spatial_ERC_snRNAseq_pseudobulk_subcluster", "LFF_spatial_ERC_snRNAseq_modeling_results_broad", - "LFF_spatial_ERC_snRNAseq_modeling_results_subcluster" + "LFF_spatial_ERC_snRNAseq_modeling_results_subcluster", + "spe_xenium_example" ), destdir = tempdir(), eh = ExperimentHub::ExperimentHub(), @@ -409,6 +410,14 @@ fetch_data <- file_name <- "sce_subcluster_pseudobulk-cell_type_anno.rds" url <- "https://www.dropbox.com/scl/fi/y42pv7k02luvznwqii2rm/sce_subcluster_modeling_results-cell_type_anno.rds?rlkey=17c0ybowjpejdxc71tuxlcfna&dl=1" + } else if (type == "spe_xenium_example") { + tag <- "LFF_spatial_ERC" + hub_title <- type + + ## While EH is not set-up + file_name <- "spe_Xenium_test.rds" + url <- + "https://www.dropbox.com/scl/fi/os4wz0kkbtmbpvnju4bxi/spe_Xenium_test.rds?rlkey=0ql1pu5d9qe448sjmkh3ja3o8&st=npwqxtdk&dl=1" } file_path <- file.path(destdir, file_name) diff --git a/R/run_app.R b/R/run_app.R index 1ae89cc0..b0bd391f 100644 --- a/R/run_app.R +++ b/R/run_app.R @@ -208,65 +208,93 @@ #' default_cluster = "scran_quick_cluster", #' is_stitched = TRUE #' ) +#' +#' ## Example for Xenium object +#' if (!exists("spe_xenium")) spe_xenium <- fetch_data("spe_xenium_example") +#' +#' run_app(spe_xenium, +#' sce_layer = NULL, modeling_results = NULL, sig_genes = NULL, +#' title = "spatialLIBD Xenium without layer info", +#' spe_discrete_vars = c( +#' "SpX", +#' "ManualAnnotation" +#' ), +#' spe_continuous_vars = c( +#' "sum_gex", # "sum_umi", +#' "detected_gex" #"sum_gene", +#' ), +#' default_cluster = "SpX", +#' datatype = "Xenium" +#' ) +#' #' } +#' run_app <- function( - spe = fetch_data(type = "spe"), - sce_layer = fetch_data(type = "sce_layer"), - modeling_results = fetch_data(type = "modeling_results"), - sig_genes = sig_genes_extract_all( - n = nrow(sce_layer), - modeling_results = modeling_results, - sce_layer = sce_layer - ), - docs_path = system.file("app", "www", package = "spatialLIBD"), - title = "spatialLIBD", - spe_discrete_vars = c( - "spatialLIBD", - "GraphBased", - "ManualAnnotation", - "Maynard", - "Martinowich", - paste0("SNN_k50_k", 4:28), - "SpatialDE_PCA", - "SpatialDE_pool_PCA", - "HVG_PCA", - "pseudobulk_PCA", - "markers_PCA", - "SpatialDE_UMAP", - "SpatialDE_pool_UMAP", - "HVG_UMAP", - "pseudobulk_UMAP", - "markers_UMAP", - "SpatialDE_PCA_spatial", - "SpatialDE_pool_PCA_spatial", - "HVG_PCA_spatial", - "pseudobulk_PCA_spatial", - "markers_PCA_spatial", - "SpatialDE_UMAP_spatial", - "SpatialDE_pool_UMAP_spatial", - "HVG_UMAP_spatial", - "pseudobulk_UMAP_spatial", - "markers_UMAP_spatial" - ), - spe_continuous_vars = c( - "cell_count", - "sum_umi", - "sum_gene", - "expr_chrM", - "expr_chrM_ratio" - ), - default_cluster = "spatialLIBD", - auto_crop_default = TRUE, - is_stitched = FALSE, - ...) { + spe = fetch_data(type = "spe"), + sce_layer = fetch_data(type = "sce_layer"), + modeling_results = fetch_data(type = "modeling_results"), + sig_genes = sig_genes_extract_all( + n = nrow(sce_layer), + modeling_results = modeling_results, + sce_layer = sce_layer + ), + docs_path = system.file("app", "www", package = "spatialLIBD"), + title = "spatialLIBD", + spe_discrete_vars = c( + "spatialLIBD", + "GraphBased", + "ManualAnnotation", + "Maynard", + "Martinowich", + paste0("SNN_k50_k", 4:28), + "SpatialDE_PCA", + "SpatialDE_pool_PCA", + "HVG_PCA", + "pseudobulk_PCA", + "markers_PCA", + "SpatialDE_UMAP", + "SpatialDE_pool_UMAP", + "HVG_UMAP", + "pseudobulk_UMAP", + "markers_UMAP", + "SpatialDE_PCA_spatial", + "SpatialDE_pool_PCA_spatial", + "HVG_PCA_spatial", + "pseudobulk_PCA_spatial", + "markers_PCA_spatial", + "SpatialDE_UMAP_spatial", + "SpatialDE_pool_UMAP_spatial", + "HVG_UMAP_spatial", + "pseudobulk_UMAP_spatial", + "markers_UMAP_spatial" + ), + spe_continuous_vars = c( + "cell_count", + "sum_umi", + "sum_gene", + "expr_chrM", + "expr_chrM_ratio" + ), + default_cluster = "spatialLIBD", + auto_crop_default = TRUE, + is_stitched = FALSE, + datatype = c("Visium", "Xenium"), + ... +) { ## Run the checks in the relevant order stopifnot(length(default_cluster) == 1) stopifnot(default_cluster %in% spe_discrete_vars) - if (is_stitched) auto_crop_default <- FALSE + if (is_stitched) { + auto_crop_default <- FALSE + } + ## Check for valid datatype + datatype <- match.arg(datatype) spe <- - check_spe(spe, - variables = c(spe_discrete_vars, spe_continuous_vars) + check_spe( + spe, + variables = c(spe_discrete_vars, spe_continuous_vars), + datatype = datatype ) ## Check sce_layer and modeling_results if needed @@ -290,7 +318,8 @@ run_app <- function( if (!is.null(sce_layer)) { ## Check required files when sce_layer is present stopifnot(file.exists(file.path( - docs_path, "documentation_sce_layer.md" + docs_path, + "documentation_sce_layer.md" ))) } @@ -306,8 +335,13 @@ run_app <- function( spe_discrete_vars = spe_discrete_vars, spe_continuous_vars = spe_continuous_vars, default_cluster = default_cluster, - auto_crop_default = auto_crop_default, + auto_crop_default = ifelse( + datatype == "Visium", + auto_crop_default, + FALSE + ), is_stitched = is_stitched, + datatype = datatype, ... ) ) diff --git a/R/vis_clus.R b/R/vis_clus.R index e10c4e72..4b925cf6 100644 --- a/R/vis_clus.R +++ b/R/vis_clus.R @@ -39,8 +39,17 @@ #' ; in #' particular, expects a logical colData column `exclude_overlapping` #' specifying which spots to exclude from the plot. Sets `auto_crop = FALSE`. -#' @param guide_point_size A `numeric(1)` specifying the size of the points in -#' guide. Defaults to `point_size`. Increase to improve visability. +#' @param guide_point_size A `numeric(1)` specifying the size of the points in +#' guide. Defaults to `point_size`. Increase to improve visibility. +#' @param datatype A `character(1)` specifying the type of spatial transcriptomics +#' data stored in `spe`. Supported options are: +#' \describe{ +#' \item{`"Visium"`}{(Default) Expects `pxl_col_in_fullres` and +#' `pxl_row_in_fullres` as columns of `spatialCoords(spe)`. Enables +#' image handling via the `spatialData` slot.} +#' \item{`"Xenium"`}{Expects `x_centroid` and `y_centroid` as columns +#' of `spatialCoords(spe)`.} +#' } #' @param ... Passed to [paste0()][base::paste] for making the title of the #' plot following the `sampleid`. #' @@ -49,12 +58,12 @@ #' @export #' @importFrom SpatialExperiment spatialCoords #' @details This function subsets `spe` to the given sample and prepares the -#' data and title for [vis_clus_p()]. +#' data and title for [vis_clus_p()] or [vis_clus_c()]. #' #' @examples #' #' if (enough_ram()) { -#' ## Obtain the necessary data +#' ## Obtain the necessary data: Visium example #' if (!exists("spe")) spe <- fetch_data("spe") #' #' ## Check the colors defined by Lukas M Weber @@ -104,7 +113,7 @@ #' ... = " LIBD Layers" #' ) #' print(p4) -#' +#' #' ## edit plot point size but keep guide size larger #' p5 <- vis_clus( #' spe = spe, @@ -117,35 +126,55 @@ #' ... = " LIBD Layers" #' ) #' print(p5) -#' +#' +#' ## Obtain the necessary data: Xenium example +#' if (!exists("spe_xenium")) spe_xenium <- fetch_data("spe_xenium_example") +#' +#' spe_xenium$x_half <- ifelse(spatialCoords(spe_xenium)[,"x_centroid"] < 3088, "left", "right") +#' +#' p6 <- vis_clus( +#' spe = spe_xenium, +#' clustervar = "x_half", +#' sampleid = "Br1556", +#' colors = c(left = "red", right = "blue"), +#' na_color = "white", +#' point_size = 1, +#' alpha = 0.5, +#' guide_point_size = 3, +#' datatype = "Xenium" +#' ) +#' print(p6) +#' #' } vis_clus <- function( - spe, - sampleid = unique(spe$sample_id)[1], - clustervar, - colors = c( - "#b2df8a", - "#e41a1c", - "#377eb8", - "#4daf4a", - "#ff7f00", - "gold", - "#a65628", - "#999999", - "black", - "grey", - "white", - "purple" - ), - spatial = TRUE, - image_id = "lowres", - alpha = NA, - point_size = 2, - auto_crop = TRUE, - na_color = "#CCCCCC40", - is_stitched = FALSE, - guide_point_size = point_size, - ...) { + spe, + sampleid = unique(spe$sample_id)[1], + clustervar, + colors = c( + "#b2df8a", + "#e41a1c", + "#377eb8", + "#4daf4a", + "#ff7f00", + "gold", + "#a65628", + "#999999", + "black", + "grey", + "white", + "purple" + ), + spatial = TRUE, + image_id = "lowres", + alpha = NA, + point_size = 2, + auto_crop = TRUE, + na_color = "#CCCCCC40", + is_stitched = FALSE, + guide_point_size = point_size, + datatype = c("Visium", "Xenium"), + ... +) { # Verify existence and legitimacy of 'sampleid' if ( !("sample_id" %in% colnames(colData(spe))) || @@ -153,47 +182,96 @@ vis_clus <- function( ) { stop( paste( - "'spe$sample_id' must exist and contain the ID", sampleid + "'spe$sample_id' must exist and contain the ID", + sampleid ), call. = FALSE ) } - # Check validity of spatial coordinates - if (!setequal(c("pxl_col_in_fullres", "pxl_row_in_fullres"), colnames(spatialCoords(spe)))) { - stop( - "Abnormal spatial coordinates: should have 'pxl_row_in_fullres' and 'pxl_col_in_fullres' columns.", - call. = FALSE - ) - } - + ## subset spe to selected sample spe_sub <- spe[, spe$sample_id == sampleid] - if (is_stitched) { - # Drop excluded spots and calculate an appropriate point size - temp <- prep_stitched_data(spe_sub, point_size, image_id) - spe_sub <- temp$spe - point_size <- temp$point_size + ## Check for valid datatype + datatype <- match.arg(datatype) - # Frame limits are poorly defined for stitched data - auto_crop <- FALSE - } + d <- as.data.frame( + cbind(colData(spe_sub), SpatialExperiment::spatialCoords(spe_sub)), + optional = TRUE + ) - d <- as.data.frame(cbind(colData(spe_sub), SpatialExperiment::spatialCoords(spe_sub)), optional = TRUE) + if (datatype == "Visium") { + # Check validity of spatial coordinates by datatype + if ( + !setequal( + c("pxl_col_in_fullres", "pxl_row_in_fullres"), + colnames(spatialCoords(spe_sub)) + ) + ) { + stop( + "Abnormal spatial coordinates for Visium datatype: should have 'pxl_row_in_fullres' and 'pxl_col_in_fullres' columns.", + call. = FALSE + ) + } - vis_clus_p( - spe = spe_sub, - d = d, - clustervar = clustervar, - sampleid = sampleid, - spatial = spatial, - title = paste0(sampleid, ...), - colors = get_colors(colors, d[, clustervar]), - image_id = image_id, - alpha = alpha, - point_size = point_size, - auto_crop = auto_crop, - na_color = na_color - ) + - guides(fill = guide_legend(override.aes = list(size = guide_point_size))) + if (is_stitched) { + # Drop excluded spots and calculate an appropriate point size + temp <- prep_stitched_data(spe_sub, point_size, image_id) + spe_sub <- temp$spe + point_size <- temp$point_size + + # Frame limits are poorly defined for stitched data + auto_crop <- FALSE + } + + vis_clus_p( + spe = spe_sub, + d = d, + clustervar = clustervar, + sampleid = sampleid, + spatial = spatial, + title = paste0(sampleid, ...), + colors = get_colors(colors, d[, clustervar]), + image_id = image_id, + alpha = alpha, + point_size = point_size, + auto_crop = auto_crop, + na_color = na_color + ) + + guides( + fill = guide_legend( + override.aes = list(size = guide_point_size) + ) + ) + } else if (datatype == "Xenium") { + if ( + datatype == "Xenium" & + !setequal( + c("x_centroid", "y_centroid"), + colnames(spatialCoords(spe_sub)) + ) + ) { + stop( + "Abnormal spatial coordinates for Xenium datatype: should have 'x_centroid' and 'y_centroid' columns.", + call. = FALSE + ) + } + + vis_clus_c( + spe = spe_sub, + d = d, + clustervar = clustervar, + sampleid = sampleid, + title = paste0(sampleid, ...), + colors = get_colors(colors, d[, clustervar]), + alpha = alpha, + point_size = point_size, + na_color = na_color + ) + + guides( + fill = guide_legend( + override.aes = list(size = guide_point_size) + ) + ) + } } diff --git a/R/vis_clus_c.R b/R/vis_clus_c.R new file mode 100644 index 00000000..eef72b31 --- /dev/null +++ b/R/vis_clus_c.R @@ -0,0 +1,116 @@ +#' Sample spatial cluster visualization workhorse function for Xenium data with +#' centroid based spatailCoords +#' +#' This function visualizes clusters or categorical variables for one given +#' sample at the cell-level. This is the function that does all the plotting +#' behind [vis_clus()] when `datatype = "Xenium"`. To visualize gene-level +#' (or any continuous variable) use [vis_gene_c()]. +#' +#' @inheritParams vis_clus +#' @inheritParams vis_clus_p +#' +#' @return A [ggplot2][ggplot2::ggplot] object. +#' @export +#' @importFrom tibble tibble +#' @importFrom SpatialExperiment imgData scaleFactors +#' @importFrom S4Vectors metadata +#' @importFrom grid rasterGrob unit +#' @family Spatial cluster visualization functions +#' +#' @examples +#' +#' if (enough_ram()) { +#' ## Obtain the necessary data +#' if (!exists("spe_xenium")) spe_xenium <- fetch_data("spe_xenium_example") +#' +#' ## Prepare the data for the plotting function +#' spe_sub <- spe_xenium[, spe_xenium$sample_id == "Br1039"] +#' +#' # summary(spatialCoords(spe_sub)[,"x_centroid"]) +#' # summary(spatialCoords(spe_sub)[,"y_centroid"]) +#' +#' ## add catagorical variable +#' spe_sub$x_half <- ifelse(spatialCoords(spe_sub)[,"x_centroid"] < 3088, "left", "right") +#' table(spe_sub$x_half) +#' +#' p <- vis_clus_c( +#' spe = spe_sub, +#' d = as.data.frame(cbind(colData(spe_sub), SpatialExperiment::spatialCoords(spe_sub)), optional = TRUE), +#' clustervar = "x_half", +#' sampleid = "sample01.1", +#' #colors = libd_layer_colors, +#' colors = c(left = "red", right = "blue"), +#' title = "Xenium test", +#' point_size = 1, +#' alpha = 0.5 +#' ) +#' print(p) +#' +#' ## Clean up +#' rm(spe_sub) +#' } +vis_clus_c <- + function( + spe, + d, + clustervar, + sampleid = unique(spe$sample_id)[1], + colors, + title, + alpha = NA, + point_size = 1, + auto_crop = TRUE, + na_color = "#CCCCCC40" + ) { + ## Some variables + x_centroid <- y_centroid <- key <- NULL + # stopifnot(all(c("x_centroid", "y_centroid", "key") %in% colnames(d))) + + # ## Crop the image if needed + # if (auto_crop) { + # frame_lims <- + # frame_limits(spe, sampleid = sampleid, image_id = image_id) + # img <- + # img[frame_lims$y_min:frame_lims$y_max, frame_lims$x_min:frame_lims$x_max] + # adjust <- + # list(x = frame_lims$x_min, y = frame_lims$y_min) + # } else { + adjust <- list(x = 0, y = 0) + # } + # + p <- ggplot( + d, + aes( + x = x_centroid, + y = y_centroid, + fill = factor(!!sym(clustervar)), + key = key + ) + ) + + p <- p + + geom_point( + shape = 21, + size = point_size, + stroke = 0, + colour = "transparent", + alpha = alpha + ) + + coord_fixed(expand = FALSE) + + scale_fill_manual(values = colors, na.value = na_color) + + xlab("") + + ylab("") + + labs(fill = NULL) + + ggtitle(title) + + theme_set(theme_bw(base_size = 20)) + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.background = element_blank(), + axis.line = element_blank(), + axis.text = element_blank(), + axis.ticks = element_blank(), + legend.box.spacing = unit(0, "pt") + ) + return(p) + } diff --git a/R/vis_clus_p.R b/R/vis_clus_p.R index b7a381d6..bd88149e 100644 --- a/R/vis_clus_p.R +++ b/R/vis_clus_p.R @@ -1,9 +1,11 @@ -#' Sample spatial cluster visualization workhorse function +#' Sample spatial cluster visualization workhorse function for Visium data with +#' pixel based spatailCoords aligned to images. #' -#' This function visualizes the clusters for one given sample at the spot-level -#' using (by default) the histology information on the background. This is the -#' function that does all the plotting behind [vis_clus()]. To visualize -#' gene-level (or any continuous variable) use [vis_gene_p()]. +#' This function visualizes the clusters or categorical variables for one given +#' sample at the spot-level using (by default) the histology information on the +#' background. This is the function that does all the plotting behind +#' [vis_clus()]. To visualize gene-level (or any continuous variable) use +#' [vis_gene_p()]. #' #' @inheritParams vis_clus #' @param d A `data.frame()` with the sample-level information. This is diff --git a/R/vis_gene.R b/R/vis_gene.R index 1e129164..05077565 100644 --- a/R/vis_gene.R +++ b/R/vis_gene.R @@ -162,25 +162,46 @@ #' multi_gene_method = "pca" #' ) #' print(p8) +#' +#' ## Obtain the necessary data: Xenium example +#' if (!exists("spe_xenium")) spe_xenium <- fetch_data("spe_xenium_test") +#' +#' p9 <- vis_gene( +#' spe = spe_xenium, +#' sampleid = "Br1556", +#' geneid = rownames(spe_xenium)[which(rowData(spe_xenium)$gene_name == "MBP")], +#' assayname = "counts", +#' point_size = 1, +#' datatype = "Xenium" +#' ) +#' print(p9) +#' #' } vis_gene <- - function(spe, - sampleid = unique(spe$sample_id)[1], - geneid = rowData(spe)$gene_search[1], - spatial = TRUE, - assayname = "logcounts", - minCount = 0, - viridis = TRUE, - image_id = "lowres", - alpha = NA, - cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), - point_size = 2, - auto_crop = TRUE, - na_color = "#CCCCCC40", - multi_gene_method = c("z_score", "pca", "sparsity"), - is_stitched = FALSE, - cap_percentile = 1, - ...) { + function( + spe, + sampleid = unique(spe$sample_id)[1], + geneid = rowData(spe)$gene_search[1], + spatial = TRUE, + assayname = "logcounts", + minCount = 0, + viridis = TRUE, + image_id = "lowres", + alpha = NA, + cont_colors = if (viridis) { + viridisLite::viridis(21) + } else { + c("aquamarine4", "springgreen", "goldenrod", "red") + }, + point_size = 2, + auto_crop = TRUE, + na_color = "#CCCCCC40", + multi_gene_method = c("z_score", "pca", "sparsity"), + is_stitched = FALSE, + cap_percentile = 1, + datatype = c("Visium", "Xenium"), + ... + ) { multi_gene_method <- rlang::arg_match(multi_gene_method) # Verify existence and legitimacy of 'sampleid' if ( @@ -189,7 +210,8 @@ vis_gene <- ) { stop( paste( - "'spe$sample_id' must exist and contain the ID", sampleid + "'spe$sample_id' must exist and contain the ID", + sampleid ), call. = FALSE ) @@ -197,35 +219,68 @@ vis_gene <- # Verify 'assayname' if (!(assayname %in% names(assays(spe)))) { - stop(sprintf("'%s' is not an assay in 'spe'", assayname), call. = FALSE) - } - - # Check validity of spatial coordinates - if (!setequal(c("pxl_col_in_fullres", "pxl_row_in_fullres"), colnames(spatialCoords(spe)))) { stop( - "Abnormal spatial coordinates: should have 'pxl_row_in_fullres' and 'pxl_col_in_fullres' columns.", + sprintf("'%s' is not an assay in 'spe'", assayname), call. = FALSE ) } + ## Check for valid datatype + datatype <- match.arg(datatype) + # Validate 'cap_percentile' if (cap_percentile <= 0 || cap_percentile > 1) { stop("'cap_percentile' must be in (0, 1]", call. = FALSE) } + ## Subset to current sample spe_sub <- spe[, spe$sample_id == sampleid] - if (is_stitched) { - # Drop excluded spots and calculate an appropriate point size - temp <- prep_stitched_data(spe_sub, point_size, image_id) - spe_sub <- temp$spe - point_size <- temp$point_size + if (datatype == "Visium") { + # Check validity of spatial coordinates + if ( + !setequal( + c("pxl_col_in_fullres", "pxl_row_in_fullres"), + colnames(spatialCoords(spe)) + ) + ) { + stop( + "Abnormal spatial coordinates for Visium datatype: should have 'pxl_row_in_fullres' and 'pxl_col_in_fullres' columns.", + call. = FALSE + ) + } + + if (is_stitched) { + # Drop excluded spots and calculate an appropriate point size + temp <- prep_stitched_data(spe_sub, point_size, image_id) + spe_sub <- temp$spe + point_size <- temp$point_size - # Frame limits are poorly defined for stitched data - auto_crop <- FALSE + # Frame limits are poorly defined for stitched data + auto_crop <- FALSE + } + } else if (datatype == "Xenium") { + # Check validity of spatial coordinates + if ( + !setequal( + c("x_centroid", "y_centroid"), + colnames(spatialCoords(spe_sub)) + ) + ) { + stop( + "Abnormal spatial coordinates for Xenium datatype: should have 'x_centroid' and 'y_centroid' columns.", + call. = FALSE + ) + } } - d <- as.data.frame(cbind(colData(spe_sub), SpatialExperiment::spatialCoords(spe_sub)), optional = TRUE) + d <- as.data.frame( + cbind( + colData(spe_sub), + SpatialExperiment::spatialCoords(spe_sub) + ), + optional = TRUE + ) # Verify legitimacy of names in geneid geneid_is_valid <- (geneid %in% rowData(spe_sub)$gene_search) | @@ -240,8 +295,8 @@ vis_gene <- } # Grab any continuous colData columns and verify they're all numeric - cont_cols <- colData(spe_sub)[ - , geneid[geneid %in% colnames(colData(spe_sub))], + cont_cols <- colData(spe_sub)[, + geneid[geneid %in% colnames(colData(spe_sub))], drop = FALSE ] if (!all(sapply(cont_cols, class) %in% c("numeric", "integer"))) { @@ -254,7 +309,9 @@ vis_gene <- # Get the integer indices of each gene in the SpatialExperiment, since we # aren't guaranteed that rownames are gene names - remaining_geneid <- geneid[!(geneid %in% colnames(colData(spe_sub)))] + remaining_geneid <- geneid[ + !(geneid %in% colnames(colData(spe_sub))) + ] valid_gene_indices <- unique( c( match(remaining_geneid, rowData(spe_sub)$gene_search), @@ -277,7 +334,11 @@ vis_gene <- plot_title <- paste(sampleid, geneid, ...) d$COUNT <- cont_matrix[, 1] if (!(geneid %in% colnames(colData(spe_sub)))) { - legend_title <- sprintf("%s\n min > %s", assayname, minCount) + legend_title <- sprintf( + "%s\n min > %s", + assayname, + minCount + ) } else { legend_title <- sprintf("min > %s", minCount) } @@ -289,7 +350,8 @@ vis_gene <- } else if (multi_gene_method == "sparsity") { d$COUNT <- multi_gene_sparsity(cont_matrix) legend_title <- paste("Prop. nonzero\n min > ", minCount) - } else { # must be 'pca' + } else { + # must be 'pca' d$COUNT <- multi_gene_pca(cont_matrix) legend_title <- paste("PC1\n min > ", minCount) } @@ -306,20 +368,36 @@ vis_gene <- d$COUNT[d$COUNT <= minCount] <- NA - p <- vis_gene_p( - spe = spe_sub, - d = d, - sampleid = sampleid, - spatial = spatial, - title = plot_title, - viridis = viridis, - image_id = image_id, - alpha = alpha, - cont_colors = cont_colors, - point_size = point_size, - auto_crop = auto_crop, - na_color = na_color, - legend_title = legend_title - ) - return(p) + if (datatype == "Visium") { + p <- vis_gene_p( + spe = spe_sub, + d = d, + sampleid = sampleid, + spatial = spatial, + title = plot_title, + viridis = viridis, + image_id = image_id, + alpha = alpha, + cont_colors = cont_colors, + point_size = point_size, + auto_crop = auto_crop, + na_color = na_color, + legend_title = legend_title + ) + return(p) + } else if (datatype == "Xenium") { + p <- vis_gene_c( + spe = spe_sub, + d = d, + sampleid = sampleid, + title = plot_title, + viridis = viridis, + alpha = alpha, + cont_colors = cont_colors, + point_size = point_size, + na_color = na_color, + legend_title = legend_title + ) + return(p) + } } diff --git a/R/vis_gene_c.R b/R/vis_gene_c.R new file mode 100644 index 00000000..82632ff0 --- /dev/null +++ b/R/vis_gene_c.R @@ -0,0 +1,131 @@ +#' Sample spatial gene visualization workhorse function for Xenium data with +#' centroid based spatailCoords +#' +#' This function visualizes the gene expression stored in `assays(spe)` or any +#' continuous variable stored in `colData(spe)` for one given sample at the +#' spot-level using (by default) the histology information on the background. +#' This is the function that does all the plotting behind [vis_clus()] when +#' `datatype = "Xenium"`. To visualize clusters (or any discrete variable) +#' use [vis_clus_c()]. +#' +#' @inheritParams vis_gene_p +#' @inheritParams vis_clus_c +#' @inheritParams vis_gene +#' +#' @return A [ggplot2][ggplot2::ggplot] object. +#' @export +#' @importFrom tibble tibble +#' @importFrom SpatialExperiment imgData scaleFactors +#' @importFrom S4Vectors metadata +#' @importFrom grid rasterGrob unit +#' @family Spatial gene visualization functions +#' +#' @examples +#' +#' if (enough_ram()) { +#' ## Obtain the necessary data +#' if (!exists("spe_xenium")) spe_xenium <- fetch_data("spe_xenium_test") +#' +#' ## Prepare the data for the plotting function +#' spe_sub <- spe_xenium[, spe_xenium$sample_id == "Br1039"] +#' df <- as.data.frame(cbind(colData(spe_sub), SpatialExperiment::spatialCoords(spe_sub)), optional = TRUE) +#' df$COUNT <- df$detected_gex +#' +#' ## Don't plot the histology information +#' p <- vis_gene_c( +#' spe = spe_sub, +#' d = df, +#' sampleid = "Br1039", +#' title = "Br1039 detected_gex", +#' point_size = 1 +#' ) +#' print(p) +#' +#' ## Clean up +#' rm(spe_sub) +#' } +vis_gene_c <- + function( + spe, + d, + sampleid = unique(spe$sample_id)[1], + title, + viridis = TRUE, + alpha = NA, + cont_colors = if (viridis) { + viridisLite::viridis(21) + } else { + c("aquamarine4", "springgreen", "goldenrod", "red") + }, + point_size = 2, + na_color = "#CCCCCC40", + legend_title = "" + ) { + ## Some variables + y_centroid <- x_centroid <- key <- COUNT <- NULL + # stopifnot(all(c("x_centroid", "y_centroid", "COUNT", "key") %in% colnames(d))) + + # ## Crop the image if needed + # if (auto_crop) { + # frame_lims <- + # frame_limits(spe, sampleid = sampleid, image_id = image_id) + # img <- + # img[frame_lims$y_min:frame_lims$y_max, frame_lims$x_min:frame_lims$x_max] + # adjust <- + # list(x = frame_lims$x_min, y = frame_lims$y_min) + # } else { + adjust <- list(x = 0, y = 0) + # } + + p <- + ggplot( + d, + aes( + x = x_centroid, + y = y_centroid, + fill = COUNT, + color = COUNT, + key = key + ) + ) + + p <- p + + geom_point( + shape = 21, + size = point_size, + stroke = 0, + colour = "transparent", + alpha = alpha + ) + + coord_fixed(expand = FALSE) + + p <- p + + scale_fill_gradientn( + name = legend_title, + colors = cont_colors, + na.value = na_color + ) + + scale_color_gradientn( + name = legend_title, + colors = cont_colors, + na.value = na_color + ) + + p <- p + + xlab("") + + ylab("") + + labs(fill = NULL, color = NULL) + + ggtitle(title) + + theme_set(theme_bw(base_size = 20)) + + theme( + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + panel.background = element_blank(), + axis.line = element_blank(), + axis.text = element_blank(), + axis.ticks = element_blank(), + legend.title = element_text(size = 10), + legend.box.spacing = unit(0, "pt") + ) + return(p) + } diff --git a/R/vis_gene_p.R b/R/vis_gene_p.R index 900bd651..eacad349 100644 --- a/R/vis_gene_p.R +++ b/R/vis_gene_p.R @@ -47,32 +47,46 @@ #' rm(spe_sub) #' } vis_gene_p <- - function(spe, - d, - sampleid = unique(spe$sample_id)[1], - spatial, - title, - viridis = TRUE, - image_id = "lowres", - alpha = NA, - cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), - point_size = 2, - auto_crop = TRUE, - na_color = "#CCCCCC40", - legend_title = "") { + function( + spe, + + d, + sampleid = unique(spe$sample_id)[1], + spatial, + title, + viridis = TRUE, + image_id = "lowres", + alpha = NA, + cont_colors = if (viridis) { + viridisLite::viridis(21) + } else { + c("aquamarine4", "springgreen", "goldenrod", "red") + }, + point_size = 2, + auto_crop = TRUE, + na_color = "#CCCCCC40", + legend_title = "" + ) { ## Some variables pxl_row_in_fullres <- pxl_col_in_fullres <- key <- COUNT <- NULL # stopifnot(all(c("pxl_col_in_fullres", "pxl_row_in_fullres", "COUNT", "key") %in% colnames(d))) img <- - SpatialExperiment::imgRaster(spe, sample_id = sampleid, image_id = image_id) + SpatialExperiment::imgRaster( + spe, + sample_id = sampleid, + image_id = image_id + ) ## Crop the image if needed if (auto_crop) { frame_lims <- frame_limits(spe, sampleid = sampleid, image_id = image_id) img <- - img[frame_lims$y_min:frame_lims$y_max, frame_lims$x_min:frame_lims$x_max] + img[ + frame_lims$y_min:frame_lims$y_max, + frame_lims$x_min:frame_lims$x_max + ] adjust <- list(x = frame_lims$x_min, y = frame_lims$y_min) } else { @@ -83,8 +97,20 @@ vis_gene_p <- ggplot( d, aes( - x = pxl_col_in_fullres * SpatialExperiment::scaleFactors(spe, sample_id = sampleid, image_id = image_id) - adjust$x, - y = pxl_row_in_fullres * SpatialExperiment::scaleFactors(spe, sample_id = sampleid, image_id = image_id) - adjust$y, + x = pxl_col_in_fullres * + SpatialExperiment::scaleFactors( + spe, + sample_id = sampleid, + image_id = image_id + ) - + adjust$x, + y = pxl_row_in_fullres * + SpatialExperiment::scaleFactors( + spe, + sample_id = sampleid, + image_id = image_id + ) - + adjust$y, fill = COUNT, color = COUNT, key = key @@ -93,12 +119,14 @@ vis_gene_p <- if (spatial) { grob <- - grid::rasterGrob(img, + grid::rasterGrob( + img, width = grid::unit(1, "npc"), height = grid::unit(1, "npc") ) p <- - p + geom_spatial( + p + + geom_spatial( data = tibble::tibble(grob = list(grob)), aes(grob = grob), x = 0.5, @@ -116,11 +144,12 @@ vis_gene_p <- ) + coord_fixed(expand = FALSE) - p <- p + scale_fill_gradientn( - name = legend_title, - colors = cont_colors, - na.value = na_color - ) + + p <- p + + scale_fill_gradientn( + name = legend_title, + colors = cont_colors, + na.value = na_color + ) + scale_color_gradientn( name = legend_title, colors = cont_colors, @@ -130,7 +159,8 @@ vis_gene_p <- p <- p + xlim(0, ncol(img)) + ylim(nrow(img), 0) + - xlab("") + ylab("") + + xlab("") + + ylab("") + labs(fill = NULL, color = NULL) + ggtitle(title) + theme_set(theme_bw(base_size = 20)) + diff --git a/R/vis_grid_clus.R b/R/vis_grid_clus.R index 64007900..a4fdf450 100644 --- a/R/vis_grid_clus.R +++ b/R/vis_grid_clus.R @@ -65,6 +65,7 @@ vis_grid_clus <- na_color = "#CCCCCC40", is_stitched = FALSE, guide_point_size = point_size, + datatype = c("Visium", "Xenium"), ... ) { stopifnot(all(sample_order %in% unique(spe$sample_id))) @@ -88,6 +89,7 @@ vis_grid_clus <- na_color = na_color, is_stitched = is_stitched, guide_point_size = guide_point_size, + datatype = datatype, ... ) }) diff --git a/R/vis_grid_gene.R b/R/vis_grid_gene.R index 6cccee2a..ef7e997b 100644 --- a/R/vis_grid_gene.R +++ b/R/vis_grid_gene.R @@ -35,26 +35,33 @@ #' cowplot::plot_grid(plotlist = p_list, ncol = 2) #' } vis_grid_gene <- - function(spe, - geneid = rowData(spe)$gene_search[1], - pdf_file, - assayname = "logcounts", - minCount = 0, - return_plots = FALSE, - spatial = TRUE, - viridis = TRUE, - height = 24, - width = 36, - image_id = "lowres", - alpha = NA, - cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", "springgreen", "goldenrod", "red"), - sample_order = unique(spe$sample_id), - point_size = 2, - auto_crop = TRUE, - na_color = "#CCCCCC40", - is_stitched = FALSE, - cap_percentile = 1, - ...) { + function( + spe, + geneid = rowData(spe)$gene_search[1], + pdf_file, + assayname = "logcounts", + minCount = 0, + return_plots = FALSE, + spatial = TRUE, + viridis = TRUE, + height = 24, + width = 36, + image_id = "lowres", + alpha = NA, + cont_colors = if (viridis) { + viridisLite::viridis(21) + } else { + c("aquamarine4", "springgreen", "goldenrod", "red") + }, + sample_order = unique(spe$sample_id), + point_size = 2, + auto_crop = TRUE, + na_color = "#CCCCCC40", + is_stitched = FALSE, + cap_percentile = 1, + datatype = c("Visium", "Xenium"), + ... + ) { stopifnot(all(sample_order %in% unique(spe$sample_id))) plots <- lapply(sample_order, function(sampleid) { @@ -74,6 +81,7 @@ vis_grid_gene <- na_color = na_color, is_stitched = is_stitched, cap_percentile = cap_percentile, + datatype = datatype, ... ) }) diff --git a/inst/extdata/metadata_LFF_spatial_ERC.csv b/inst/extdata/metadata_LFF_spatial_ERC.csv index 91bcc02a..2ee49fdc 100644 --- a/inst/extdata/metadata_LFF_spatial_ERC.csv +++ b/inst/extdata/metadata_LFF_spatial_ERC.csv @@ -7,3 +7,4 @@ "LFF_spatial_ERC_snRNAseq_pseudobulk_subcluster","Pseudo-bulked SingleCellExperiment object LFF_spatial_ERC human brain (ERC) snRNA-seq data (n = 31) at 38 subcluster resolution, from the Chromium platform from 10x Genomics generated by the Lieber Institute for Brain Development (LIBD) and available through the spatialLIBD Bioconductor package.","3.21","GRCh38","GTF","https://bioconductor.org/packages/spatialLIBD","Nov 20 2025","Homo sapiens",9606,TRUE,"LIBD","Leonardo Collado-Torres ","SingleCellExperiment","Rds","spatialLIBD/spatialLIBD_files/sce_subcluster_pseudobulk-cell_type_anno.rds","Visium_snRNAseq_AD_Alzheimer_Disease_APOE_ERC_spatialLIBD" "LFF_spatial_ERC_snRNAseq_modeling_results_broad","List of modeling results at the 9 broad cell type resolution for the LFF_spatial_ERC human brain (ERC) for snRNA-seq (n = 31) from the Chromium platform from 10x Genomics generated by the Lieber Institute for Brain Development (LIBD) and available through the spatialLIBD Bioconductor package.","3.21","GRCh38","GTF","https://bioconductor.org/packages/spatialLIBD","Nov 20 2025","Homo sapiens",9606,TRUE,"LIBD","Leonardo Collado-Torres ","list","Rds","spatialLIBD/spatialLIBD_files/sce_subcluster_pseudobulk-cell_type_broad.rds","Visium_snRNAseq_AD_Alzheimer_Disease_APOE_ERC_spatialLIBD" "LFF_spatial_ERC_snRNAseq_modeling_results_subcluster","List of modeling results at the 38 subcluster resolution for the LFF_spatial_ERC human brain (ERC) for snRNA-seq (n = 31) from the Chromium platform from 10x Genomics generated by the Lieber Institute for Brain Development (LIBD) and available through the spatialLIBD Bioconductor package.","3.21","GRCh38","GTF","https://bioconductor.org/packages/spatialLIBD","Nov 20 2025","Homo sapiens",9606,TRUE,"LIBD","Leonardo Collado-Torres ","list","Rds","spatialLIBD/spatialLIBD_files/sce_subcluster_modeling_results-cell_type_anno.rds","Visium_snRNAseq_AD_Alzheimer_Disease_APOE_ERC_spatialLIBD" +"spe_xenium_example","SpatialExperiment object with example Xenium data (n = 2) from the LFF_spatial_ERC human brain (ERC) spatial transcriptomics data from the Xenium platform from 10x Genomics generated by the Lieber Institute for Brain Development (LIBD) and available through the spatialLIBD Bioconductor package.","3.21","GRCh38","GTF","https://bioconductor.org/packages/spatialLIBD","May 20 2026","Homo sapiens",9606,TRUE,"LIBD","Leonardo Collado-Torres ","SpatialExperiment","Rds","spatialLIBD/spatialLIBD_files/spe_Xenium_test.rds","Visium_snRNAseq_AD_Alzheimer_Disease_APOE_ERC_spatialLIBD" diff --git a/inst/scripts/make-metadata_LFF_spatial_ERC.R b/inst/scripts/make-metadata_LFF_spatial_ERC.R index 4ec828be..dc25f9d0 100644 --- a/inst/scripts/make-metadata_LFF_spatial_ERC.R +++ b/inst/scripts/make-metadata_LFF_spatial_ERC.R @@ -15,7 +15,8 @@ meta <- data.frame( "LFF_spatial_ERC_snRNAseq_pseudobulk_broad", "LFF_spatial_ERC_snRNAseq_pseudobulk_subcluster", "LFF_spatial_ERC_snRNAseq_modeling_results_broad", - "LFF_spatial_ERC_snRNAseq_modeling_results_subcluster" + "LFF_spatial_ERC_snRNAseq_modeling_results_subcluster", + "spe_xenium_example" ), Description = c( "SpatialExperiment object at the spot-level for the LFF_spatial_ERC human brain (ERC) spatial transcriptomics data (n = 31) from the Visium platform from 10x Genomics generated by the Lieber Institute for Brain Development (LIBD) and available through the spatialLIBD Bioconductor package.", @@ -25,13 +26,14 @@ meta <- data.frame( "Pseudo-bulked SingleCellExperiment object LFF_spatial_ERC human brain (ERC) snRNA-seq data (n = 31) at 9 broad cell type resolution, from the Chromium platform from 10x Genomics generated by the Lieber Institute for Brain Development (LIBD) and available through the spatialLIBD Bioconductor package.", "Pseudo-bulked SingleCellExperiment object LFF_spatial_ERC human brain (ERC) snRNA-seq data (n = 31) at 38 subcluster resolution, from the Chromium platform from 10x Genomics generated by the Lieber Institute for Brain Development (LIBD) and available through the spatialLIBD Bioconductor package.", "List of modeling results at the 9 broad cell type resolution for the LFF_spatial_ERC human brain (ERC) for snRNA-seq (n = 31) from the Chromium platform from 10x Genomics generated by the Lieber Institute for Brain Development (LIBD) and available through the spatialLIBD Bioconductor package.", - "List of modeling results at the 38 subcluster resolution for the LFF_spatial_ERC human brain (ERC) for snRNA-seq (n = 31) from the Chromium platform from 10x Genomics generated by the Lieber Institute for Brain Development (LIBD) and available through the spatialLIBD Bioconductor package." + "List of modeling results at the 38 subcluster resolution for the LFF_spatial_ERC human brain (ERC) for snRNA-seq (n = 31) from the Chromium platform from 10x Genomics generated by the Lieber Institute for Brain Development (LIBD) and available through the spatialLIBD Bioconductor package.", + "SpatialExperiment object with example Xenium data (n = 2) from the LFF_spatial_ERC human brain (ERC) spatial transcriptomics data from the Xenium platform from 10x Genomics generated by the Lieber Institute for Brain Development (LIBD) and available through the spatialLIBD Bioconductor package." ), BiocVersion = "3.21", Genome = "GRCh38", SourceType = "GTF", SourceUrl = "https://bioconductor.org/packages/spatialLIBD", - SourceVersion = "Nov 20 2025", + SourceVersion = rep(c("Nov 20 2025", "May 20 2026"), c(8, 1)), Species = "Homo sapiens", TaxonomyId = 9606, Coordinate_1_based = TRUE, @@ -45,7 +47,8 @@ meta <- data.frame( "SingleCellExperiment", "SingleCellExperiment", "list", - "list" + "list", + "SpatialExperiment" ), DispatchClass = c( "FilePath", @@ -55,6 +58,7 @@ meta <- data.frame( "Rds", "Rds", "Rds", + "Rds", "Rds" ), RDataPath = file.path( @@ -68,7 +72,8 @@ meta <- data.frame( "sce_subcluster_pseudobulk-cell_type_broad.rds", "sce_subcluster_pseudobulk-cell_type_anno.rds", "sce_subcluster_pseudobulk-cell_type_broad.rds", - "sce_subcluster_modeling_results-cell_type_anno.rds" + "sce_subcluster_modeling_results-cell_type_anno.rds", + "spe_Xenium_test.rds" ) ), Tags = "Visium_snRNAseq_AD_Alzheimer_Disease_APOE_ERC_spatialLIBD", diff --git a/man/check_spe.Rd b/man/check_spe.Rd index 577afeec..30c7d5d8 100644 --- a/man/check_spe.Rd +++ b/man/check_spe.Rd @@ -6,7 +6,8 @@ \usage{ check_spe( spe, - variables = c("sum_umi", "sum_gene", "expr_chrM", "expr_chrM_ratio") + variables = c("sum_umi", "sum_gene", "expr_chrM", "expr_chrM_ratio"), + datatype = c("Visium", "Xenium") ) } \arguments{ @@ -18,6 +19,16 @@ build your own \code{spe} object.} \item{variables}{A \code{character()} vector of variable names expected to be present in \code{colData(spe)}.} + +\item{datatype}{A \code{character(1)} specifying the type of spatial transcriptomics +data stored in \code{spe}. Supported options are: +\describe{ +\item{\code{"Visium"}}{(Default) Expects \code{pxl_col_in_fullres} and +\code{pxl_row_in_fullres} as columns of \code{spatialCoords(spe)}. Enables +image handling via the \code{spatialData} slot.} +\item{\code{"Xenium"}}{Expects \code{x_centroid} and \code{y_centroid} as columns +of \code{spatialCoords(spe)}.} +}} } \value{ The input object if all checks are passed. diff --git a/man/fetch_data.Rd b/man/fetch_data.Rd index 1c90603f..73eed5fa 100644 --- a/man/fetch_data.Rd +++ b/man/fetch_data.Rd @@ -19,7 +19,7 @@ fetch_data( "LFF_spatial_ERC_snRNAseq_pseudobulk_broad", "LFF_spatial_ERC_snRNAseq_pseudobulk_subcluster", "LFF_spatial_ERC_snRNAseq_modeling_results_broad", - "LFF_spatial_ERC_snRNAseq_modeling_results_subcluster"), + "LFF_spatial_ERC_snRNAseq_modeling_results_subcluster", "spe_xenium_example"), destdir = tempdir(), eh = ExperimentHub::ExperimentHub(), bfc = BiocFileCache::BiocFileCache() diff --git a/man/frame_limits.Rd b/man/frame_limits.Rd index b24b2af4..d224682f 100644 --- a/man/frame_limits.Rd +++ b/man/frame_limits.Rd @@ -58,6 +58,7 @@ if (enough_ram()) { \seealso{ Other Spatial cluster visualization functions: \code{\link{vis_clus}()}, +\code{\link{vis_clus_c}()}, \code{\link{vis_clus_p}()}, \code{\link{vis_grid_clus}()}, \code{\link{vis_image}()} diff --git a/man/run_app.Rd b/man/run_app.Rd index dc46f93d..bb1153d3 100644 --- a/man/run_app.Rd +++ b/man/run_app.Rd @@ -25,6 +25,7 @@ run_app( default_cluster = "spatialLIBD", auto_crop_default = TRUE, is_stitched = FALSE, + datatype = c("Visium", "Xenium"), ... ) } @@ -84,6 +85,16 @@ with \code{visiumStitched::build_spe()}. particular, expects a logical colData column \code{exclude_overlapping} specifying which spots to exclude from the plot. Sets \code{auto_crop = FALSE}.} +\item{datatype}{A \code{character(1)} specifying the type of spatial transcriptomics +data stored in \code{spe}. Supported options are: +\describe{ +\item{\code{"Visium"}}{(Default) Expects \code{pxl_col_in_fullres} and +\code{pxl_row_in_fullres} as columns of \code{spatialCoords(spe)}. Enables +image handling via the \code{spatialData} slot.} +\item{\code{"Xenium"}}{Expects \code{x_centroid} and \code{y_centroid} as columns +of \code{spatialCoords(spe)}.} +}} + \item{...}{Other arguments passed to the list of golem options for running the application.} } @@ -264,5 +275,25 @@ run_app( default_cluster = "scran_quick_cluster", is_stitched = TRUE ) + +## Example for Xenium object +if (!exists("spe_xenium")) spe_xenium <- fetch_data("spe_xenium_example") + +run_app(spe_xenium, + sce_layer = NULL, modeling_results = NULL, sig_genes = NULL, + title = "spatialLIBD Xenium without layer info", + spe_discrete_vars = c( + "SpX", + "ManualAnnotation" + ), + spe_continuous_vars = c( + "sum_gex", # "sum_umi", + "detected_gex" #"sum_gene", + ), + default_cluster = "SpX", + datatype = "Xenium" +) + } + } diff --git a/man/vis_clus.Rd b/man/vis_clus.Rd index c01c8028..1cafb6c5 100644 --- a/man/vis_clus.Rd +++ b/man/vis_clus.Rd @@ -18,6 +18,7 @@ vis_clus( na_color = "#CCCCCC40", is_stitched = FALSE, guide_point_size = point_size, + datatype = c("Visium", "Xenium"), ... ) } @@ -69,7 +70,17 @@ particular, expects a logical colData column \code{exclude_overlapping} specifying which spots to exclude from the plot. Sets \code{auto_crop = FALSE}.} \item{guide_point_size}{A \code{numeric(1)} specifying the size of the points in -guide. Defaults to \code{point_size}. Increase to improve visability.} +guide. Defaults to \code{point_size}. Increase to improve visibility.} + +\item{datatype}{A \code{character(1)} specifying the type of spatial transcriptomics +data stored in \code{spe}. Supported options are: +\describe{ +\item{\code{"Visium"}}{(Default) Expects \code{pxl_col_in_fullres} and +\code{pxl_row_in_fullres} as columns of \code{spatialCoords(spe)}. Enables +image handling via the \code{spatialData} slot.} +\item{\code{"Xenium"}}{Expects \code{x_centroid} and \code{y_centroid} as columns +of \code{spatialCoords(spe)}.} +}} \item{...}{Passed to \link[base:paste]{paste0()} for making the title of the plot following the \code{sampleid}.} @@ -84,12 +95,12 @@ gene-level (or any continuous variable) use \code{\link[=vis_gene]{vis_gene()}}. } \details{ This function subsets \code{spe} to the given sample and prepares the -data and title for \code{\link[=vis_clus_p]{vis_clus_p()}}. +data and title for \code{\link[=vis_clus_p]{vis_clus_p()}} or \code{\link[=vis_clus_c]{vis_clus_c()}}. } \examples{ if (enough_ram()) { - ## Obtain the necessary data + ## Obtain the necessary data: Visium example if (!exists("spe")) spe <- fetch_data("spe") ## Check the colors defined by Lukas M Weber @@ -139,7 +150,7 @@ if (enough_ram()) { ... = " LIBD Layers" ) print(p4) - + ## edit plot point size but keep guide size larger p5 <- vis_clus( spe = spe, @@ -152,12 +163,31 @@ if (enough_ram()) { ... = " LIBD Layers" ) print(p5) - + + ## Obtain the necessary data: Xenium example + if (!exists("spe_xenium")) spe_xenium <- fetch_data("spe_xenium_example") + + spe_xenium$x_half <- ifelse(spatialCoords(spe_xenium)[,"x_centroid"] < 3088, "left", "right") + + p6 <- vis_clus( + spe = spe_xenium, + clustervar = "x_half", + sampleid = "Br1556", + colors = c(left = "red", right = "blue"), + na_color = "white", + point_size = 1, + alpha = 0.5, + guide_point_size = 3, + datatype = "Xenium" + ) + print(p6) + } } \seealso{ Other Spatial cluster visualization functions: \code{\link{frame_limits}()}, +\code{\link{vis_clus_c}()}, \code{\link{vis_clus_p}()}, \code{\link{vis_grid_clus}()}, \code{\link{vis_image}()} diff --git a/man/vis_clus_c.Rd b/man/vis_clus_c.Rd new file mode 100644 index 00000000..981f9683 --- /dev/null +++ b/man/vis_clus_c.Rd @@ -0,0 +1,109 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/vis_clus_c.R +\name{vis_clus_c} +\alias{vis_clus_c} +\title{Sample spatial cluster visualization workhorse function for Xenium data with +centroid based spatailCoords} +\usage{ +vis_clus_c( + spe, + d, + clustervar, + sampleid = unique(spe$sample_id)[1], + colors, + title, + alpha = NA, + point_size = 1, + auto_crop = TRUE, + na_color = "#CCCCCC40" +) +} +\arguments{ +\item{spe}{A +\link[SpatialExperiment:SpatialExperiment]{SpatialExperiment-class} +object. See \code{\link[=fetch_data]{fetch_data()}} for how to download some example objects or +\code{\link[=read10xVisiumWrapper]{read10xVisiumWrapper()}} to read in \code{spaceranger --count} output files and +build your own \code{spe} object.} + +\item{d}{A \code{data.frame()} with the sample-level information. This is +typically obtained using \code{cbind(colData(spe), spatialCoords(spe))}.} + +\item{clustervar}{A \code{character(1)} with the name of the \code{colData(spe)} +column that has the cluster values.} + +\item{sampleid}{A \code{character(1)} specifying which sample to plot from +\code{colData(spe)$sample_id} (formerly \code{colData(spe)$sample_name}).} + +\item{colors}{A vector of colors to use for visualizing the clusters +from \code{clustervar}. If the vector has names, then those should match the +values of \code{clustervar}.} + +\item{title}{The title for the plot.} + +\item{alpha}{A \code{numeric(1)} in the \verb{[0, 1]} range that specifies the +transparency level of the data on the spots.} + +\item{point_size}{A \code{numeric(1)} specifying the size of the points. Defaults +to \code{1.25}. Some colors look better if you use \code{2} for instance.} + +\item{auto_crop}{A \code{logical(1)} indicating whether to automatically crop +the image / plotting area, which is useful if the Visium capture area is +not centered on the image and if the image is not a square.} + +\item{na_color}{A \code{character(1)} specifying a color for the NA values. +If you set \code{alpha = NA} then it's best to set \code{na_color} to a color that has +alpha blending already, which will make non-NA values pop up more and the NA +values will show with a lighter color. This behavior is lost when \code{alpha} is +set to a non-\code{NA} value.} +} +\value{ +A \link[ggplot2:ggplot]{ggplot2} object. +} +\description{ +This function visualizes clusters or categorical variables for one given +sample at the cell-level. This is the function that does all the plotting +behind \code{\link[=vis_clus]{vis_clus()}} when \code{datatype = "Xenium"}. To visualize gene-level +(or any continuous variable) use \code{\link[=vis_gene_c]{vis_gene_c()}}. +} +\examples{ + +if (enough_ram()) { + ## Obtain the necessary data + if (!exists("spe_xenium")) spe_xenium <- fetch_data("spe_xenium_example") + + ## Prepare the data for the plotting function + spe_sub <- spe_xenium[, spe_xenium$sample_id == "Br1039"] + + # summary(spatialCoords(spe_sub)[,"x_centroid"]) + # summary(spatialCoords(spe_sub)[,"y_centroid"]) + + ## add catagorical variable + spe_sub$x_half <- ifelse(spatialCoords(spe_sub)[,"x_centroid"] < 3088, "left", "right") + table(spe_sub$x_half) + + p <- vis_clus_c( + spe = spe_sub, + d = as.data.frame(cbind(colData(spe_sub), SpatialExperiment::spatialCoords(spe_sub)), optional = TRUE), + clustervar = "x_half", + sampleid = "sample01.1", + #colors = libd_layer_colors, + colors = c(left = "red", right = "blue"), + title = "Xenium test", + point_size = 1, + alpha = 0.5 + ) + print(p) + + ## Clean up + rm(spe_sub) +} +} +\seealso{ +Other Spatial cluster visualization functions: +\code{\link{frame_limits}()}, +\code{\link{vis_clus}()}, +\code{\link{vis_clus_p}()}, +\code{\link{vis_grid_clus}()}, +\code{\link{vis_image}()} +} +\concept{Spatial cluster visualization functions} diff --git a/man/vis_clus_p.Rd b/man/vis_clus_p.Rd index ced22bc7..0a7b1dc0 100644 --- a/man/vis_clus_p.Rd +++ b/man/vis_clus_p.Rd @@ -2,7 +2,8 @@ % Please edit documentation in R/vis_clus_p.R \name{vis_clus_p} \alias{vis_clus_p} -\title{Sample spatial cluster visualization workhorse function} +\title{Sample spatial cluster visualization workhorse function for Visium data with +pixel based spatailCoords aligned to images.} \usage{ vis_clus_p( spe, @@ -68,10 +69,11 @@ set to a non-\code{NA} value.} A \link[ggplot2:ggplot]{ggplot2} object. } \description{ -This function visualizes the clusters for one given sample at the spot-level -using (by default) the histology information on the background. This is the -function that does all the plotting behind \code{\link[=vis_clus]{vis_clus()}}. To visualize -gene-level (or any continuous variable) use \code{\link[=vis_gene_p]{vis_gene_p()}}. +This function visualizes the clusters or categorical variables for one given +sample at the spot-level using (by default) the histology information on the +background. This is the function that does all the plotting behind +\code{\link[=vis_clus]{vis_clus()}}. To visualize gene-level (or any continuous variable) use +\code{\link[=vis_gene_p]{vis_gene_p()}}. } \examples{ @@ -101,6 +103,7 @@ if (enough_ram()) { Other Spatial cluster visualization functions: \code{\link{frame_limits}()}, \code{\link{vis_clus}()}, +\code{\link{vis_clus_c}()}, \code{\link{vis_grid_clus}()}, \code{\link{vis_image}()} } diff --git a/man/vis_gene.Rd b/man/vis_gene.Rd index 49fe828c..6a85ae2c 100644 --- a/man/vis_gene.Rd +++ b/man/vis_gene.Rd @@ -14,14 +14,19 @@ vis_gene( viridis = TRUE, image_id = "lowres", alpha = NA, - cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", - "springgreen", "goldenrod", "red"), + cont_colors = if (viridis) { + viridisLite::viridis(21) + } else { + + c("aquamarine4", "springgreen", "goldenrod", "red") + }, point_size = 2, auto_crop = TRUE, na_color = "#CCCCCC40", multi_gene_method = c("z_score", "pca", "sparsity"), is_stitched = FALSE, cap_percentile = 1, + datatype = c("Visium", "Xenium"), ... ) } @@ -107,6 +112,16 @@ of 0.95 sets the top 5\% of expression values to the 95th percentile value. This can help make the color scale more dynamic in the presence of high outliers. Defaults to \code{1}, which effectively performs no capping.} +\item{datatype}{A \code{character(1)} specifying the type of spatial transcriptomics +data stored in \code{spe}. Supported options are: +\describe{ +\item{\code{"Visium"}}{(Default) Expects \code{pxl_col_in_fullres} and +\code{pxl_row_in_fullres} as columns of \code{spatialCoords(spe)}. Enables +image handling via the \code{spatialData} slot.} +\item{\code{"Xenium"}}{Expects \code{x_centroid} and \code{y_centroid} as columns +of \code{spatialCoords(spe)}.} +}} + \item{...}{Passed to \link[base:paste]{paste0()} for making the title of the plot following the \code{sampleid}.} } @@ -234,10 +249,25 @@ if (enough_ram()) { multi_gene_method = "pca" ) print(p8) + + ## Obtain the necessary data: Xenium example + if (!exists("spe_xenium")) spe_xenium <- fetch_data("spe_xenium_test") + + p9 <- vis_gene( + spe = spe_xenium, + sampleid = "Br1556", + geneid = rownames(spe_xenium)[which(rowData(spe_xenium)$gene_name == "MBP")], + assayname = "counts", + point_size = 1, + datatype = "Xenium" + ) + print(p9) + } } \seealso{ Other Spatial gene visualization functions: +\code{\link{vis_gene_c}()}, \code{\link{vis_gene_p}()}, \code{\link{vis_grid_gene}()} } diff --git a/man/vis_gene_c.Rd b/man/vis_gene_c.Rd new file mode 100644 index 00000000..6fa1e11b --- /dev/null +++ b/man/vis_gene_c.Rd @@ -0,0 +1,109 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/vis_gene_c.R +\name{vis_gene_c} +\alias{vis_gene_c} +\title{Sample spatial gene visualization workhorse function for Xenium data with +centroid based spatailCoords} +\usage{ +vis_gene_c( + spe, + d, + sampleid = unique(spe$sample_id)[1], + title, + viridis = TRUE, + alpha = NA, + cont_colors = if (viridis) { + viridisLite::viridis(21) + } else { + + c("aquamarine4", "springgreen", "goldenrod", "red") + }, + point_size = 2, + na_color = "#CCCCCC40", + legend_title = "" +) +} +\arguments{ +\item{spe}{A +\link[SpatialExperiment:SpatialExperiment]{SpatialExperiment-class} +object. See \code{\link[=fetch_data]{fetch_data()}} for how to download some example objects or +\code{\link[=read10xVisiumWrapper]{read10xVisiumWrapper()}} to read in \code{spaceranger --count} output files and +build your own \code{spe} object.} + +\item{d}{A \code{data.frame()} with the sample-level information. This is +typically obtained using \code{cbind(colData(spe), spatialCoords(spe))}. +The \code{data.frame} has to contain +a column with the continuous variable data to plot stored under \code{d$COUNT}.} + +\item{sampleid}{A \code{character(1)} specifying which sample to plot from +\code{colData(spe)$sample_id} (formerly \code{colData(spe)$sample_name}).} + +\item{title}{The title for the plot.} + +\item{viridis}{A \code{logical(1)} whether to use the color-blind friendly +palette from \link[viridisLite:viridis]{viridis} or the color palette used +in the paper that was chosen for contrast when visualizing the data on +top of the histology image. One issue is being able to differentiate low +values from NA ones due to the purple-ish histology information that is +dependent on cell density.} + +\item{alpha}{A \code{numeric(1)} in the \verb{[0, 1]} range that specifies the +transparency level of the data on the spots.} + +\item{cont_colors}{A \code{character()} vector of colors that supersedes the +\code{viridis} argument.} + +\item{point_size}{A \code{numeric(1)} specifying the size of the points. Defaults +to \code{1.25}. Some colors look better if you use \code{2} for instance.} + +\item{na_color}{A \code{character(1)} specifying a color for the NA values. +If you set \code{alpha = NA} then it's best to set \code{na_color} to a color that has +alpha blending already, which will make non-NA values pop up more and the NA +values will show with a lighter color. This behavior is lost when \code{alpha} is +set to a non-\code{NA} value.} + +\item{legend_title}{A \code{character(1)} specifying the legend title.} +} +\value{ +A \link[ggplot2:ggplot]{ggplot2} object. +} +\description{ +This function visualizes the gene expression stored in \code{assays(spe)} or any +continuous variable stored in \code{colData(spe)} for one given sample at the +spot-level using (by default) the histology information on the background. +This is the function that does all the plotting behind \code{\link[=vis_clus]{vis_clus()}} when +\code{datatype = "Xenium"}. To visualize clusters (or any discrete variable) +use \code{\link[=vis_clus_c]{vis_clus_c()}}. +} +\examples{ + +if (enough_ram()) { + ## Obtain the necessary data + if (!exists("spe_xenium")) spe_xenium <- fetch_data("spe_xenium_test") + + ## Prepare the data for the plotting function + spe_sub <- spe_xenium[, spe_xenium$sample_id == "Br1039"] + df <- as.data.frame(cbind(colData(spe_sub), SpatialExperiment::spatialCoords(spe_sub)), optional = TRUE) + df$COUNT <- df$detected_gex + + ## Don't plot the histology information + p <- vis_gene_c( + spe = spe_sub, + d = df, + sampleid = "Br1039", + title = "Br1039 detected_gex", + point_size = 1 + ) + print(p) + + ## Clean up + rm(spe_sub) +} +} +\seealso{ +Other Spatial gene visualization functions: +\code{\link{vis_gene}()}, +\code{\link{vis_gene_p}()}, +\code{\link{vis_grid_gene}()} +} +\concept{Spatial gene visualization functions} diff --git a/man/vis_gene_p.Rd b/man/vis_gene_p.Rd index ca9d6a29..60ffadf0 100644 --- a/man/vis_gene_p.Rd +++ b/man/vis_gene_p.Rd @@ -13,8 +13,12 @@ vis_gene_p( viridis = TRUE, image_id = "lowres", alpha = NA, - cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", - "springgreen", "goldenrod", "red"), + cont_colors = if (viridis) { + viridisLite::viridis(21) + } else { + + c("aquamarine4", "springgreen", "goldenrod", "red") + }, point_size = 2, auto_crop = TRUE, na_color = "#CCCCCC40", @@ -111,6 +115,7 @@ if (enough_ram()) { \seealso{ Other Spatial gene visualization functions: \code{\link{vis_gene}()}, +\code{\link{vis_gene_c}()}, \code{\link{vis_grid_gene}()} } \concept{Spatial gene visualization functions} diff --git a/man/vis_grid_clus.Rd b/man/vis_grid_clus.Rd index ba69f862..58026a73 100644 --- a/man/vis_grid_clus.Rd +++ b/man/vis_grid_clus.Rd @@ -22,6 +22,7 @@ vis_grid_clus( na_color = "#CCCCCC40", is_stitched = FALSE, guide_point_size = point_size, + datatype = c("Visium", "Xenium"), ... ) } @@ -86,7 +87,17 @@ particular, expects a logical colData column \code{exclude_overlapping} specifying which spots to exclude from the plot. Sets \code{auto_crop = FALSE}.} \item{guide_point_size}{A \code{numeric(1)} specifying the size of the points in -guide. Defaults to \code{point_size}. Increase to improve visability.} +guide. Defaults to \code{point_size}. Increase to improve visibility.} + +\item{datatype}{A \code{character(1)} specifying the type of spatial transcriptomics +data stored in \code{spe}. Supported options are: +\describe{ +\item{\code{"Visium"}}{(Default) Expects \code{pxl_col_in_fullres} and +\code{pxl_row_in_fullres} as columns of \code{spatialCoords(spe)}. Enables +image handling via the \code{spatialData} slot.} +\item{\code{"Xenium"}}{Expects \code{x_centroid} and \code{y_centroid} as columns +of \code{spatialCoords(spe)}.} +}} \item{...}{Passed to \link[base:paste]{paste0()} for making the title of the plot following the \code{sampleid}.} @@ -130,6 +141,7 @@ if (enough_ram()) { Other Spatial cluster visualization functions: \code{\link{frame_limits}()}, \code{\link{vis_clus}()}, +\code{\link{vis_clus_c}()}, \code{\link{vis_clus_p}()}, \code{\link{vis_image}()} } diff --git a/man/vis_grid_gene.Rd b/man/vis_grid_gene.Rd index 647cdce9..63305f9c 100644 --- a/man/vis_grid_gene.Rd +++ b/man/vis_grid_gene.Rd @@ -17,14 +17,19 @@ vis_grid_gene( width = 36, image_id = "lowres", alpha = NA, - cont_colors = if (viridis) viridisLite::viridis(21) else c("aquamarine4", - "springgreen", "goldenrod", "red"), + cont_colors = if (viridis) { + viridisLite::viridis(21) + } else { + + c("aquamarine4", "springgreen", "goldenrod", "red") + }, sample_order = unique(spe$sample_id), point_size = 2, auto_crop = TRUE, na_color = "#CCCCCC40", is_stitched = FALSE, cap_percentile = 1, + datatype = c("Visium", "Xenium"), ... ) } @@ -108,6 +113,16 @@ of 0.95 sets the top 5\% of expression values to the 95th percentile value. This can help make the color scale more dynamic in the presence of high outliers. Defaults to \code{1}, which effectively performs no capping.} +\item{datatype}{A \code{character(1)} specifying the type of spatial transcriptomics +data stored in \code{spe}. Supported options are: +\describe{ +\item{\code{"Visium"}}{(Default) Expects \code{pxl_col_in_fullres} and +\code{pxl_row_in_fullres} as columns of \code{spatialCoords(spe)}. Enables +image handling via the \code{spatialData} slot.} +\item{\code{"Xenium"}}{Expects \code{x_centroid} and \code{y_centroid} as columns +of \code{spatialCoords(spe)}.} +}} + \item{...}{Passed to \link[base:paste]{paste0()} for making the title of the plot following the \code{sampleid}.} } @@ -147,6 +162,7 @@ if (enough_ram()) { \seealso{ Other Spatial gene visualization functions: \code{\link{vis_gene}()}, +\code{\link{vis_gene_c}()}, \code{\link{vis_gene_p}()} } \concept{Spatial gene visualization functions} diff --git a/man/vis_image.Rd b/man/vis_image.Rd index 943c3a6b..d0626aaa 100644 --- a/man/vis_image.Rd +++ b/man/vis_image.Rd @@ -77,6 +77,7 @@ if (enough_ram()) { Other Spatial cluster visualization functions: \code{\link{frame_limits}()}, \code{\link{vis_clus}()}, +\code{\link{vis_clus_c}()}, \code{\link{vis_clus_p}()}, \code{\link{vis_grid_clus}()} }