Merge branch 'devel' into pseudobulkDGE_compatable

Author: lcolladotor

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: spatialLIBD
 Title: spatialLIBD: an R/Bioconductor package to visualize spatially-resolved
  transcriptomics data
-Version: 1.19.12
-Date: 2025-04-03
+Version: 1.21.2
+Date: 2025-04-24
 Authors@R:
  c(
  person("Leonardo", "Collado-Torres", role = c("aut", "cre"), 

NAMESPACE

@@ -45,6 +45,7 @@ export(vis_gene)
 export(vis_gene_p)
 export(vis_grid_clus)
 export(vis_grid_gene)
+export(vis_image)
 import(ExperimentHub)
 import(MatrixGenerics)
 import(SingleCellExperiment)

NEWS.md

@@ -1,3 +1,22 @@
+# spatialLIBD 1.21.2
+
+NEW FEATURES
+
+* @lahuuki added the `vis_image()` for plotting just the histology image. See 
+<https://github.com/LieberInstitute/spatialLIBD/pull/107> for details.
+
+# spatialLIBD 1.21.1
+
+SIGNIFICANT USER-VISIBLE CHANGES
+
+* The documentation of `registration_pseudobulk()` has been expanded to further
+explain the `logcounts()` assay. That is, to highlight that this assay
+contains log2 CPM values computed with `edgeR::cpm()` and not log2 library-size
+normalized counts (as computed with `scuttle::logNormCounts()`).
+See <https://support.bioconductor.org/p/9161754> and 
+<https://github.com/LieberInstitute/spatialLIBD/issues/106> by @kinnaryshah
+for more details.
+
 # spatialLIBD 1.19.12
 
 NEW FEATURES

R/registration_pseudobulk.R

@@ -28,7 +28,12 @@
 #' mitochondrial, used to calculate pseudo bulked mitochondrial expression rate
 #' `expr_chrM` and `pseudo_expr_chrM` .
 #'
-#' @return A pseudo-bulked [SingleCellExperiment-class][SingleCellExperiment::SingleCellExperiment-class] object.
+#' @return A pseudo-bulked [SingleCellExperiment-class][SingleCellExperiment::SingleCellExperiment-class] object. The `logcounts()` assay are `log2-CPM`
+#' values calculated with `edgeR::cpm(log = TRUE)`. See
+#' <https://github.com/LieberInstitute/spatialLIBD/issues/106> and
+#' <https://support.bioconductor.org/p/9161754> for more details about the
+#' math behind `scuttle::logNormFactors()`, `edgeR::cpm()`, and their
+#' differences.
 #' @importFrom SingleCellExperiment logcounts
 #' @importFrom scuttle aggregateAcrossCells
 #' @importFrom edgeR filterByExpr calcNormFactors
@@ -76,7 +81,8 @@ registration_pseudobulk <-
  stopifnot(var_registration %in% colnames(colData(sce)))
  stopifnot(var_sample_id %in% colnames(colData(sce)))
  stopifnot(all(
- !c("registration_sample_id", "registration_variable") %in% colnames(colData(sce))
+ !c("registration_sample_id", "registration_variable") %in%
+ colnames(colData(sce))
  ))
 
  ## Avoid any incorrect inputs that are otherwise hard to detect
@@ -110,7 +116,10 @@ registration_pseudobulk <-
  "var_registration \"%s\" contains non-syntatic variables: %s\nconverting to %s",
  var_registration,
  paste(uniq_var_regis[!syntatic], collapse = ", "),
- paste(make.names(uniq_var_regis[!syntatic]), collapse = ", ")
+ paste(
+ make.names(uniq_var_regis[!syntatic]),
+ collapse = ", "
+ )
  ),
  call. = FALSE
  )
@@ -167,7 +176,9 @@ registration_pseudobulk <-
  if (is.factor(sce_pseudo$registration_variable)) {
  ## Drop unused var_registration levels if we had to drop some due
  ## to min_ncells
- sce_pseudo$registration_variable <- droplevels(sce_pseudo$registration_variable)
+ sce_pseudo$registration_variable <- droplevels(
+ sce_pseudo$registration_variable
+ )
  }
 
  ## compute pseudo QC metrics
@@ -195,7 +206,8 @@ registration_pseudobulk <-
  ## Compute the logcounts
  message(Sys.time(), " normalize expression")
  logcounts(sce_pseudo) <-
- edgeR::cpm(edgeR::calcNormFactors(sce_pseudo),
+ edgeR::cpm(
+ edgeR::calcNormFactors(sce_pseudo),
  log = TRUE,
  prior.count = 1
  )

R/vis_image.R

@@ -0,0 +1,140 @@
+#' Sample image visualization
+#'
+#' This function visualizes the histology image for selected sample. Matches
+#' crop and settings of [vis_clus()] and [vis_gene()].
+#'
+#' @inheritParams vis_clus
+#' @param title_suffix A `character(1)` passed to [paste()][base::paste] to
+#' modify the title of the plot following the `sampleid`.
+#'
+#' @return A [ggplot2][ggplot2::ggplot] object.
+#' @family Spatial cluster visualization functions
+#' @export
+#' @importFrom SpatialExperiment spatialCoords
+#' @details This function subsets `spe` to the given sample and prepares the
+#' data and title for [vis_clus_p()].
+#'
+#' @examples
+#'
+#' if (enough_ram()) {
+#' ## Obtain the necessary data
+#' if (!exists("spe")) spe <- fetch_data("spe")
+#'
+#' ## Print the "lowres" image for sample 151673
+#' p1 <- vis_image(
+#' spe = spe,
+#' sampleid = "151673"
+#' )
+#' print(p1)
+#'
+#' ## Without auto-cropping the image
+#' p2 <- vis_image(
+#' spe = spe,
+#' sampleid = "151673",
+#' auto_crop = FALSE
+#' )
+#' print(p2)
+#' }
+vis_image <- function(
+ spe,
+ sampleid = unique(spe$sample_id)[1],
+ image_id = "lowres",
+ auto_crop = TRUE,
+ is_stitched = FALSE,
+ title_suffix = NULL
+) {
+ # Verify existence and legitimacy of 'sampleid'
+ if (
+ !("sample_id" %in% colnames(colData(spe))) ||
+ !(sampleid %in% spe$sample_id)
+ ) {
+ stop(
+ paste(
+ "'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
+ )
+ }
+
+ spe_sub <- spe[, spe$sample_id == sampleid]
+
+ if (is_stitched) {
+ # 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
+ )
+
+ pxl_row_in_fullres <- pxl_col_in_fullres <- key <- NULL
+
+ img <- 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
+ ]
+ adjust <-
+ list(x = frame_lims$x_min, y = frame_lims$y_min)
+ } else {
+ adjust <- list(x = 0, y = 0)
+ }
+
+ title <- paste(sampleid, title_suffix)
+
+ grob <- grid::rasterGrob(
+ img,
+ width = grid::unit(1, "npc"),
+ height = grid::unit(1, "npc")
+ )
+
+ p <- ggplot() +
+ geom_spatial(
+ data = tibble::tibble(grob = list(grob)),
+ aes(grob = grob),
+ x = 0.5,
+ y = 0.5
+ ) +
+ xlim(0, ncol(img)) +
+ ylim(nrow(img), 0) +
+ 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)
+}