add shape plotting

Author: HelenaLC

NAMESPACE

@@ -18,6 +18,8 @@ export(sd_osn_list)
 export(sd_osn_load)
 export(sd_plot)
 export(sd_plot_image)
+export(sd_plot_point)
+export(sd_plot_shape)
 export(sdio_list)
 export(zattrs)
 import(geoarrow)
@@ -46,11 +48,14 @@ importFrom(S7,new_generic)
 importFrom(S7,new_union)
 importFrom(SingleCellExperiment,"int_metadata<-")
 importFrom(SingleCellExperiment,int_metadata)
+importFrom(SummarizedExperiment,assay)
 importFrom(SummarizedExperiment,colData)
 importFrom(anndataR,read_zarr)
 importFrom(arrow,open_dataset)
 importFrom(grDevices,col2rgb)
 importFrom(grDevices,rgb)
 importFrom(methods,as)
 importFrom(methods,is)
+importFrom(rlang,.data)
+importFrom(sfarrow,read_sf_dataset)
 importFrom(utils,.DollarNames)

R/plot-point.R

@@ -0,0 +1,73 @@
+#' @name sd_plot_point
+#' @title Plot `PointFrame`
+#'
+#' @param x \code{\link{SpatialData}} object.
+#' @param i scalar integer or string; 
+#'   specifies which \code{points} to plot.
+#' @param c string; can be a color name or 
+#'   \code{PointFrame} column to color by.
+#' @param a assay to use when coloring by \code{tables}.
+#' @param ... (optional) aesthetics passed to \code{geom_point}.
+#'
+#' @return \code{ggplot}
+#'
+#' @examples
+#' pa <- file.path("extdata", "blobs.zarr")
+#' pa <- system.file(pa, package="SpatialData")
+#' sd <- readSpatialData(pa)
+#' 
+#' sd_plot() + sd_plot_point(sd, c="x")
+#' sd_plot() + sd_plot_point(sd, c="pink", size=1)
+#'
+#' @importFrom SingleCellExperiment int_metadata
+#' @importFrom SummarizedExperiment assay
+#' @importFrom rlang .data
+#' @import ggplot2
+#' @export
+sd_plot_point <- \(x, i, c, a, ...) {
+    dot <- list(...)
+    if (missing(c)) c <- NULL
+    if (missing(i)) i <- 1
+    if (is.numeric(i)) i <- names(x)$points[i]
+    p <- x@points[[i]]
+    df <- as.data.frame(p@data)
+    aes <- aes(.data[["x"]], .data[["y"]])
+    lgd <- "none"
+    if (!is.null(c)) {
+        if (.str_is_col(c)) {
+            dot$colour <- c
+        } else if (c %in% names(df)) {
+            aes$colour <- aes(.data[[c]])[[1]]
+        } else {
+            stopifnot(length(x@tables) > 0)
+            id <- int_metadata(t)$zattrs$region
+            stopifnot(id == i)
+            t <- x@tables[[1]]
+            ik <- instance_key(p)
+            idx <- match(df[[ik]], t[[ik]])
+            a <- ifelse(missing(a), 1, a)
+            if (c %in% rownames(t))
+                t[[c]] <- assay(t, a)[c, ]
+            df[[c]] <- t[[c]][idx]
+            aes$colour <- aes(.data[[c]])[[1]]
+        }
+        if (c %in% names(df)) 
+            lgd <- scale_type(df[[c]])
+    } 
+    arg <- c(list(data=df, mapping=aes), dot)
+    list(
+        do.call(geom_point, arg), 
+        switch(lgd,
+            discrete=list(
+                theme(legend.key.size=unit(0, "lines")),
+                guides(col=guide_legend(override.aes=list(alpha=1, size=2)))
+            ),
+            continuous=list(
+                theme(
+                    legend.key.width=unit(0.4, "lines"),
+                    legend.key.height=unit(0.8, "lines")),
+                scale_color_gradientn(colors=pals::jet())
+            )
+        )
+    )
+}

R/plot-shape.R

@@ -0,0 +1,51 @@
+#' @name sd_plot_shape
+#' @title Plot `ShapeFrame`
+#'
+#' @param x \code{\link{SpatialData}} object.
+#' @param i scalar integer or string; 
+#'   specifies which \code{shapes} to plot.
+#' @param c string; can be a color name,
+#'   or TRUE to color by shape identifier.
+#' @param ... (optional) aesthetics passed to \code{geom_sf}.
+#'
+#' @return \code{ggplot}
+#'
+#' @examples
+#' pa <- file.path("extdata", "blobs.zarr")
+#' pa <- system.file(pa, package="SpatialData")
+#' sd <- readSpatialData(pa)
+#' 
+#' sd_plot() + sd_plot_shape(sd, 1) # point
+#' sd_plot() + sd_plot_shape(sd, 3) # polygon
+#' sd_plot() + sd_plot_shape(sd, 2) # multi-polygon
+#'
+#' # aesthetics
+#' sd_plot() + sd_plot_shape(sd, 3, 
+#'   fill=NA, c="red", linewidth=1)
+#'
+#' @importFrom sfarrow read_sf_dataset
+#' @importFrom rlang .data
+#' @import ggplot2
+#' @export
+sd_plot_shape <- \(x, i=1, c=TRUE, ...) {
+    if (is.numeric(i)) 
+        i <- names(x)$shapes[i]
+    s <- x@shapes[[i]]
+    df <- read_sf_dataset(s@data)
+    aes <- aes()
+    thm <- list()
+    dot <- list(...)
+    if (isTRUE(c)) {
+        df$.id <- factor(seq(nrow(df)))
+        aes$colour <- aes(.data$.id)[[1]]
+        thm <- c(thm, list(guides(col="none")))
+    } else if (.str_is_col(c)) {
+        ex <- grepv("col", names(dot))
+        dot <- dot[setdiff(names(dot), ex)]
+        dot$colour <- c
+    }
+    if (!is.null(df$radius)) 
+        aes$size <- aes(.data$radius)[[1]]
+    arg <- c(list(data=df, mapping=aes), dot)
+    list(do.call(geom_sf, arg), thm)
+}

R/plot-utils.R

@@ -0,0 +1,2 @@
+#' @importFrom grDevices col2rgb
+.str_is_col <- \(x) !inherits(tryCatch(error=\(e) e, col2rgb(x)), "error")

R/plot.R

@@ -2,18 +2,34 @@
 #' @title Plotting `SpatialData`
 #' 
 #' @aliases sd_plot sd_plot_image
-#' 
-#' @import ggplot2
+#'
+#' @return \code{ggplot}
+#'
 #' @examples
 #' pa <- file.path("extdata", "blobs.zarr")
 #' pa <- system.file(pa, package="SpatialData")
 #' sd <- readSpatialData(pa)
 #' 
-#' sd_plot() + sd_plot_image(sd)
+#' sd_plot() + 
+#'   sd_plot_image(sd) +
+#'   sd_plot_point(sd, c="x") 
 #' 
 #' pal <- c("cyan", "magenta", "gold")
 #' sd_plot() + sd_plot_image(sd, c=pal)
-NULL
+#'
+#' @import ggplot2 
+#' @export
+sd_plot <- \() ggplot() + 
+    #scale_y_reverse() +
+    coord_equal() + 
+    theme_bw() + theme(
+        panel.grid=element_blank(),
+        legend.key=element_blank(),
+        legend.key.size=unit(0, "lines"),
+        legend.background=element_blank(),
+        plot.title=element_text(hjust=0.5),
+        axis.text=element_text(color="grey"),
+        axis.ticks=element_line(color="grey"))
 
 # default colors (from ImageJ/Fiji)
 .DEFAULT_COLORS <- c("red", "green", "blue", "gray", "cyan", "magenta", "yellow")
@@ -175,17 +191,3 @@ sd_plot_image <- \(x, i=1, k=NULL, c=NULL, ch=NULL, cl=NULL, w=800, h=800) {
         scale_x_continuous(limits=w), scale_y_reverse(limits=rev(h)),
         annotation_raster(a, w[2],w[1], h[1],h[2], interpolate=FALSE))
 }
-
-#' @rdname sd_plot
-#' @export
-sd_plot <- \() ggplot() + 
-    #scale_y_reverse() +
-    coord_equal() + 
-    theme_bw() + theme(
-        panel.grid=element_blank(),
-        legend.key=element_blank(),
-        legend.key.size=unit(0, "lines"),
-        legend.background=element_blank(),
-        plot.title=element_text(hjust=0.5),
-        axis.text=element_text(color="grey"),
-        axis.ticks=element_line(color="grey"))