Issue 150 plotCoregulationSpatial (#160)

plotCoregulationProfileSpatial support for multiple samples

R/geseca-plot.R

@@ -47,9 +47,9 @@ plotCoregulationProfile <- function(pathway, E,
         geom_point(alpha = 0.1) +
         geom_path(alpha = 0.2) +
         geom_line(data = pointDt, aes(x = x, y = y),
-                  group = "mean", color = "#13242a", size = 1.5) +
-        geom_hline(yintercept = min(pointDt$y), color = "#495057", linetype = "dashed", size = 1) +
-        geom_hline(yintercept = max(pointDt$y), color = "#495057", linetype = "dashed", size = 1) +
+                  group = "mean", color = "#13242a", linewidth = 1.5) +
+        geom_hline(yintercept = min(pointDt$y), color = "#495057", linetype = "dashed", linewidth = 1) +
+        geom_hline(yintercept = max(pointDt$y), color = "#495057", linetype = "dashed", linewidth = 1) +
         (if (!is.null(conditions)) {
             geom_point(shape=21, size=4,
                        data = pointDt,
@@ -254,6 +254,8 @@ plotGesecaTable <- function(gesecaRes,
 #' @param colors vector of three colors to use in the color scheme
 #' @param guide option for `ggplot2::scale_color_gradientn` to control for presence of the color legend
 #' the same universe of genes in the scaled data
+#' @param image.alpha adjust the opacity of the background images
+#' @param ... optional arguments for \link[Seurat]{SpatialFeaturePlot}
 #' @return ggplot object (or a list of objects) with the coregulation profile plot
 #'
 #' When the input is a list of pathways, pathway names are used for titles.
@@ -266,52 +268,55 @@ plotCoregulationProfileSpatial <- function(pathway,
                                            title=NULL,
                                            assay=DefaultAssay(object),
                                            colors=c("darkblue", "lightgrey", "darkred"),
-                                           guide="colourbar") {
+                                           guide="colourbar",
+                                           image.alpha = 0,
+                                           ...) {
     stopifnot(requireNamespace("Seurat"))
     # TODO duplicated code with plotCoregulationProfileReduction
     if (is.list(pathway)) {
         if (is.null(title)) {
             titles <- names(pathway)
-        } else {
+        }
+        else {
             if (length(title) != length(pathway)) {
                 stop("Length of the specified titles does not match count of pathways")
             }
             titles <- title
         }
         ps <- lapply(seq_along(pathway), function(i)
             plotCoregulationProfileSpatial(pathway[[i]],
-                                           object=object,
-                                           title=titles[i],
-                                           assay=assay,
-                                           colors=colors))
+                                           object = object,
+                                           title = titles[i],
+                                           assay = assay,
+                                           colors = colors,
+                                           image.alpha = image.alpha,
+                                           ...))
         names(ps) <- names(pathway)
+        ps <- unlist(ps, recursive = FALSE)
         return(ps)
     }
 
 
-
-    obj2 <- addGesecaScores(list(pathway=pathway), object, assay=assay,
-                            scale=TRUE)
-
-    p <- Seurat::SpatialFeaturePlot(obj2, features = "pathway",
-                                    combine = FALSE, image.alpha = 0)[[1]]
-    p$scales$scales[p$scales$find("fill")] <- NULL
-
+    obj2 <- addGesecaScores(list(pathway = pathway), object,
+                                    assay = assay, scale = TRUE)
+    ps <- Seurat::SpatialFeaturePlot(obj2, features = "pathway",
+                                     combine = FALSE, image.alpha = image.alpha, ...)
     # suppress message of replacing existing color palette
-    suppressMessages({
-        p2 <- p +
-            scale_fill_gradientn(limits=c(-3, 3), breaks=c(-3, 0, 3),
-                                 oob=scales::squish,
-                                 colors=colors,
-                                 guide = guide,
-                                 name = "z-score"
-            ) + theme(legend.position = theme_get()$legend.position)
-    })
-
-    if (!is.null(title)) {
-        p2 <- p2 + ggtitle(title)
+    suppressMessages(ps <- lapply(ps, function(p){
+        res <- p + scale_fill_gradientn(limits = c(-3, 3),
+                                        breaks = c(-3, 0, 3),
+                                        oob = scales::squish,
+                                        colors = colors,
+                                        guide = guide,
+                                        name = "z-score")
+        res <- res + theme(legend.position = theme_get()$legend.position)
+        return(res)
+    }))
+
+    if (!is.null(title)){
+        ps <- lapply(ps, function(p) p + ggtitle(title))
     }
-    p2
+    return(ps)
 }
 
 addGesecaScores <- function(pathways,

R/plot.R

@@ -94,7 +94,7 @@ plotGseaTable <- function(pathways, stats, fgseaRes,
             ggplot() +
                 geom_segment(aes(x=p, xend=p,
                                  y=0, yend=statsAdj[p]),
-                             size=0.2) +
+                             linewidth=0.2) +
                 scale_x_continuous(limits=c(0, length(statsAdj)),
                                    expand=c(0, 0)) +
                 scale_y_continuous(limits=c(-1, 1),

vignettes/fgsea-tutorial.Rmd

@@ -175,3 +175,9 @@ bg <- names(exampleRanks)
 foraRes <- fora(genes=fg, universe=bg, pathways=examplePathways)
 head(foraRes)
 ```
+
+## Session info
+
+```{r}
+sessionInfo()
+```

vignettes/geseca-tutorial.Rmd

@@ -349,8 +349,20 @@ Finally, let us plot spatial expression of the top four pathways:
 topPathways <- gesecaRes[, pathway] |> head(4)
 titles <- sub("HALLMARK_", "", topPathways)
 
+pt.size.factor <- 1.6
+
+
+# Starting from Seurat version 5.1.0, the scaling method for spatial plots was changed.
+# As mentioned here: https://github.com/satijalab/seurat/issues/9049
+# This code provides a workaround to adapt to the new scaling behavior.
+if (packageVersion("Seurat") >= "5.1.0"){
+    sfactors <- ScaleFactors(obj@images$slice1)
+    pt.size.factor <- 1.5 * sfactors$fiducial / sfactors$hires
+}
+
 ps <- plotCoregulationProfileSpatial(pathways[topPathways], obj,
-                                       title=titles)
+                                     title=titles, 
+                                     pt.size.factor=pt.size.factor)
 cowplot::plot_grid(plotlist=ps, ncol=2)
 ```
 
@@ -363,8 +375,15 @@ is more characteristic to the "normal" tissue region:
 ```{r fig.width=5, fig.height=3.5, out.width="50%"}
 plotCoregulationProfileSpatial(pathways$HALLMARK_OXIDATIVE_PHOSPHORYLATION,
                                obj,
-                               title=sprintf("HALLMARK_OXIDATIVE_PHOSPHORYLATION (pval=%.2g)",
+                               pt.size.factor=pt.size.factor,
+                               title=sprintf("HALLMARK_OXIDATIVE_PHOSPHORYLATION\n(pval=%.2g)",
                                              gesecaRes[
                                                  match("HALLMARK_OXIDATIVE_PHOSPHORYLATION", pathway),
                                                  pval]))
 ```
+
+## Session info
+
+```{r echo=TRUE}
+sessionInfo()
+```