Skip to content

Commit 02ff2c3

Browse files
pwwangpwwang
committed
feat: add plots spatial data (wip)
1 parent bf9d7c4 commit 02ff2c3

File tree

9 files changed

+16425
-1
lines changed

9 files changed

+16425
-1
lines changed

‎Makefile

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,4 +12,9 @@ install:
1212
test:
1313
Rscript <(echo "devtools::test()")
1414

15-
.PHONY: readme docs install test
15+
notebooks:
16+
jupyter nbconvert --to html notebooks/spatial/*.ipynb --output-dir=pkgdown/assets
17+
18+
notebook: notebooks
19+
20+
.PHONY: readme docs install test notebooks notebook

‎NAMESPACE

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
# Generated by roxygen2: do not edit by hand
22

3+
S3method(SpatialDimPlot,Seurat)
4+
S3method(SpatialFeaturePlot,Seurat)
35
export(CCCPlot)
46
export(CellDimPlot)
57
export(CellStatPlot)
@@ -22,6 +24,8 @@ export(FeatureStatPlot)
2224
export(GSEAPlot)
2325
export(GSEASummaryPlot)
2426
export(SCPlotterChat)
27+
export(SpatialDimPlot)
28+
export(SpatialFeaturePlot)
2529
export(VolcanoPlot)
2630
import(R6)
2731
importFrom(SeuratObject,DefaultDimReduc)
@@ -99,6 +103,10 @@ importFrom(plotthis,RidgePlot)
99103
importFrom(plotthis,RingPlot)
100104
importFrom(plotthis,SankeyPlot)
101105
importFrom(plotthis,ScatterPlot)
106+
importFrom(plotthis,SpatialImagePlot)
107+
importFrom(plotthis,SpatialMasksPlot)
108+
importFrom(plotthis,SpatialPointsPlot)
109+
importFrom(plotthis,SpatialShapesPlot)
102110
importFrom(plotthis,SpiderPlot)
103111
importFrom(plotthis,TrendPlot)
104112
importFrom(plotthis,UpsetPlot)

‎R/spatialplot.R

Lines changed: 252 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,252 @@
1+
#' Plot features for spatial data
2+
#'
3+
#' The features can include expression, dimension reduction components, metadata, etc
4+
#'
5+
#' @param object A Seurat object or a Giotto object.
6+
#' @return A ggplot object
7+
#' @keywords internal
8+
#' @rdname SpatialPlot
9+
SpatialPlot <- function(object, ...) {
10+
UseMethod("SpatialPlot", object)
11+
}
12+
13+
#' @keywords internal
14+
#' @rdname SpatialPlot
15+
SpatialPlot.Seurat <- function(object, image = NULL, ...) {
16+
first_image <- Seurat::Images(object)[1]
17+
image <- image %||% first_image
18+
stype <- class(object@images[[first_image]])
19+
if ("VisiumV2" %in% stype) {
20+
SpatialPlot.Seurat.VisiumV2(object, image = image, ...)
21+
}
22+
}
23+
24+
#' @keywords internal
25+
#' @rdname SpatialPlot
26+
#' @importFrom plotthis SpatialImagePlot SpatialMasksPlot SpatialShapesPlot SpatialPointsPlot
27+
SpatialPlot.Seurat.VisiumV2 <- function(
28+
object, image = NULL, masks = NULL, shapes = NULL, points = NULL, ext = NULL,
29+
image_scale = NULL, crop = TRUE, group_by = NULL, features = NULL, layer = "data",
30+
layers = NULL, flip_y = TRUE, theme = "plotthis::theme_box", theme_args = list(),
31+
label = FALSE, label_size = 4, label_fg = "white", label_bg = "black", label_bg_r = 0.1,
32+
label_repel = FALSE, label_repulsion = 20, label_pt_size = 1, label_pt_color = "black",
33+
label_segment_color = "black", label_insitu = FALSE,
34+
palette = NULL, palette_reverse = FALSE, palcolor = NULL,
35+
highlight = NULL, highlight_alpha = 1, highlight_size = 1, highlight_color = "black", highlight_stroke = 0.8,
36+
legend.position = "right", legend.direction = "vertical",
37+
facet_scales = "fixed", facet_nrow = NULL, facet_ncol = NULL, facet_byrow = TRUE,
38+
...
39+
40+
) {
41+
42+
ggplot <- if (getOption("plotthis.gglogger.enabled", FALSE)) {
43+
gglogger::ggplot
44+
} else {
45+
ggplot2::ggplot
46+
}
47+
stopifnot("[SpatialPlot] Either 'group_by' or 'features' should be provided, not both." = is.null(group_by) || is.null(features))
48+
49+
points <- points %||% TRUE
50+
51+
layers <- intersect(
52+
layers %||% c("image", "masks", "shapes", "points"),
53+
c(
54+
if (!is.null(image) && !isFALSE(image)) "image",
55+
if (!is.null(masks) && !isFALSE(masks)) "masks",
56+
if (!is.null(shapes) && !isFALSE(shapes)) "shapes",
57+
if (!is.null(points) && !isFALSE(points)) "points"
58+
)
59+
)
60+
stopifnot('Either "image", "masks", "shapes", or "points" must be provided.' = any(layers %in% c("image", "masks", "shapes", "points")))
61+
if ("image" %in% layers && layers[1] != "image") {
62+
stop('If "image" is provided, it must be the first element in "layers".')
63+
}
64+
65+
players <- list()
66+
scales_used <- c()
67+
args <- rlang::dots_list(...)
68+
scale_factor <- 1
69+
facet_by <- NULL
70+
ext_unscaled <- NULL
71+
if (crop) {
72+
points_data <- Seurat::GetTissueCoordinates(object)
73+
points_data$.y <- points_data$x
74+
points_data$x <- points_data$y
75+
points_data$y <- points_data$.y
76+
points_data$.y <- NULL
77+
padding <- 0.05
78+
delta_x <- diff(range(points_data$x, na.rm = TRUE)) * padding
79+
delta_y <- diff(range(points_data$y, na.rm = TRUE)) * padding
80+
ext_unscaled <- c(
81+
min(points_data$x, na.rm = TRUE) - delta_x,
82+
max(points_data$x, na.rm = TRUE) + delta_x,
83+
min(points_data$y, na.rm = TRUE) - delta_y,
84+
max(points_data$y, na.rm = TRUE) + delta_y
85+
)
86+
}
87+
for (element in layers) {
88+
if (element == "image" && !is.null(image)) {
89+
image_obj <- object@images[[image]]
90+
img <- terra::rast(image_obj@image)
91+
image_scale <- image_scale %||% which.min(image_obj@scale.factors)
92+
scale_factor <- image_obj@scale.factors[[image_scale]]
93+
# img <- terra::crop(img, ext, extend = TRUE)
94+
image_args <- args[startsWith(names(args), "image_")]
95+
names(image_args) <- sub("^image_", "", names(image_args))
96+
image_args$data <- terra::flip(img, direction = "vertical")
97+
image_args$flip_y <- flip_y
98+
image_args$return_layer <- TRUE
99+
image_args$ext <- if (!is.null(ext_unscaled)) ext_unscaled * scale_factor
100+
player <- do.call(SpatialImagePlot, image_args)
101+
scales_reused <- intersect(scales_used, attr(player, "scales"))
102+
players <- c(players, list(player))
103+
scales_used <- unique(c(scales_used, attr(player, "scales")))
104+
}
105+
if (element == "points" && !is.null(points)) {
106+
points_args <- args[startsWith(names(args), "points_")]
107+
names(points_args) <- sub("^points_", "", names(points_args))
108+
if (crop) {
109+
# attach metadata for highlighting selection
110+
points_args$data <- object@meta.data[rownames(points_data), , drop = FALSE]
111+
points_args$data <- cbind(points_args$data, points_data)
112+
points_args$data$x <- points_args$data$x * scale_factor
113+
points_args$data$y <- points_args$data$y * scale_factor
114+
points_args$ext <- ext %||% (ext_unscaled * scale_factor)
115+
} else {
116+
points_args$data <- Seurat::GetTissueCoordinates(object, image = if(isFALSE(image)) NULL else image)
117+
points_args$data$.y <- points_args$data$x * scale_factor
118+
points_args$data$x <- points_args$data$y * scale_factor
119+
points_args$data$y <- points_args$data$.y
120+
points_args$data$.y <- NULL
121+
points_args$data <- cbind(
122+
object@meta.data[rownames(points_args$data), , drop = FALSE],
123+
points_args$data
124+
)
125+
}
126+
if (!is.null(group_by)) {
127+
points_args$data[[group_by]] <- object@meta.data[[group_by]]
128+
points_args$color_by <- group_by
129+
points_args$legend.position <- legend.position
130+
points_args$legend.direction <- legend.direction
131+
points_args$label <- label
132+
points_args$label_size <- label_size
133+
points_args$label_fg <- label_fg
134+
points_args$label_bg <- label_bg
135+
points_args$label_bg_r <- label_bg_r
136+
points_args$label_repel <- label_repel
137+
points_args$label_repulsion <- label_repulsion
138+
points_args$label_pt_size <- label_pt_size
139+
points_args$label_pt_color <- label_pt_color
140+
points_args$label_segment_color <- label_segment_color
141+
points_args$label_insitu <- label_insitu
142+
} else if (!is.null(features)) {
143+
cells <- unique(Seurat:::CellsByImage(object, images = if(isFALSE(image)) NULL else image, unlist = TRUE))
144+
featdata <- Seurat::FetchData(
145+
object = object,
146+
vars = features,
147+
cells = cells,
148+
layer = layer,
149+
clean = FALSE
150+
)
151+
features <- colnames(featdata)
152+
points_args$data[, features] <- featdata
153+
points_args$color_by <- colnames(featdata)
154+
points_args$legend.position <- legend.position
155+
points_args$legend.direction <- legend.direction
156+
if (length(features) == 1) {
157+
points_args$color_name <- points_args$color_name %||% features
158+
} else {
159+
points_args$color_name <- points_args$color_name %||% "feature"
160+
facet_by <- ".facet_var"
161+
}
162+
}
163+
d <<- points_args$data
164+
points_args$highlight <- highlight
165+
points_args$highlight_alpha <- highlight_alpha
166+
points_args$highlight_size <- highlight_size
167+
points_args$highlight_color <- highlight_color
168+
points_args$highlight_stroke <- highlight_stroke
169+
points_args$palette <- points_args$palette %||% palette
170+
points_args$palette_reverse <- points_args$palette_reverse %||% palette_reverse
171+
points_args$palcolor <- points_args$palcolor %||% palcolor
172+
points_args$flip_y <- flip_y
173+
points_args$return_layer <- TRUE
174+
player <- do.call(SpatialPointsPlot, points_args)
175+
scales_reused <- intersect(scales_used, attr(player, "scales"))
176+
if ("fill" %in% scales_reused) {
177+
players <- c(players, list(ggnewscale::new_scale_fill()))
178+
}
179+
players <- c(players, list(player))
180+
scales_used <- unique(c(scales_used, attr(player, "scales")))
181+
}
182+
if (element == "masks" && !is.null(masks)) {
183+
stop("[SpatialPlot] 'masks' is not supported for Seurat Visium V2 objects.")
184+
}
185+
if (element == "shapes" && !is.null(shapes)) {
186+
stop("[SpatialPlot] 'shapes' is not supported for Seurat Visium V2 objects.")
187+
}
188+
}
189+
190+
xlim <- ylim <- NULL
191+
if (!is.null(ext_unscaled)) {
192+
ext <- ext %||% ext_unscaled * scale_factor
193+
}
194+
if (!is.null(ext)) {
195+
xlim <- c(ext[1], ext[2])
196+
ylim <- c(-ext[4], -ext[3])
197+
}
198+
199+
p <- ggplot() +
200+
players +
201+
ggplot2::coord_sf(expand = 0, xlim = xlim, ylim = ylim) +
202+
do.call(plotthis:::process_theme(theme), theme_args) +
203+
ggplot2::scale_y_continuous(labels = abs)
204+
205+
if (!is.null(facet_by)) {
206+
p <- plotthis:::facet_plot(
207+
p, facet_by, facet_scales, facet_nrow, facet_ncol, facet_byrow,
208+
legend.position = legend.position, legend.direction = legend.direction
209+
)
210+
}
211+
212+
p
213+
}
214+
215+
216+
#' Plot features for spatial data
217+
#'
218+
#' The features can include expression, dimension reduction components, metadata, etc
219+
#'
220+
#' @param object A Seurat object or a Giotto object.
221+
#' @return A ggplot object
222+
#' @export
223+
#' @rdname SpatialPlot
224+
SpatialFeaturePlot <- function(object, ...) {
225+
UseMethod("SpatialFeaturePlot", object)
226+
}
227+
228+
#' @export
229+
#' @rdname SpatialPlot
230+
SpatialFeaturePlot.Seurat <- function(object, image = NULL, ...) {
231+
SpatialPlot(object, image = image, ...)
232+
}
233+
234+
#' Plot categories for spatial data
235+
#'
236+
#' @param object A Seurat object or a Giotto object.
237+
#' @return A ggplot object
238+
#' @export
239+
#' @rdname SpatialPlot
240+
SpatialDimPlot <- function(object, ...) {
241+
UseMethod("SpatialDimPlot", object)
242+
}
243+
244+
#' @export
245+
#' @rdname SpatialPlot
246+
SpatialDimPlot.Seurat <- function(object, image = NULL, group_by = NULL, ...) {
247+
if (is.null(group_by)) {
248+
group_by <- "Identity"
249+
object@meta.data$Identity <- Seurat::Idents(object)
250+
}
251+
SpatialPlot.Seurat(object, image = image, group_by = group_by, ...)
252+
}

‎_pkgdown.yml

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,16 @@ url: https://pwwang.github.io/scplotter/
22
template:
33
bootstrap: 5
44
bootswatch: lumen
5+
navbar:
6+
structure:
7+
left: [intro, reference, articles, spatial, tutorials, news]
8+
right: [search, github]
9+
components:
10+
spatial:
11+
text: Spatial
12+
menu:
13+
- text: "Visualizing 10x Visum data prepared with Seurat"
14+
href: Seurat.10x_Visium.html
515
reference:
616
- title: scRNA-seq
717
desc: Functions for plotting single cell RNA-seq data
@@ -28,6 +38,11 @@ reference:
2838
- ClonalPositionalPlot
2939
- ClonalKmerPlot
3040
- ClonalRarefactionPlot
41+
- title: Spatial data visualization
42+
desc: Functions for plotting spatial data
43+
contents:
44+
- SpatialDimPlot
45+
- SpatialFeaturePlot
3146
- title: Visualizing using LLMs
3247
desc: Functions/Classes for visualizing using LLMs
3348
contents:

0 commit comments

Comments
 (0)
pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy