draft of "use_geoms"

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: SpatialData.plot
 Title: SpatialData visualization
 Depends: R (>= 4.4), SpatialData
-Version: 0.99.2
+Version: 0.99.3
 Description: Visualization suit for 'SpatialData' (R). Current functionality 
     includes handling of multiscale 'images', visualizing 'labels', 'points', 
     and 'shapes'. For the latter, POINT, POLYGON, and MULTIPOLYGON geometries 

NAMESPACE

@@ -1,6 +1,9 @@
 # Generated by roxygen2: do not edit by hand
 
+export(add_points)
+export(add_tx)
 export(plotSpatialData)
+export(viewShape)
 exportMethods(plotImage)
 exportMethods(plotLabel)
 exportMethods(plotPoint)
@@ -9,13 +12,19 @@ exportMethods(rotate)
 exportMethods(scale)
 exportMethods(translation)
 import(SpatialData)
+import(ggplot2)
 importFrom(DelayedArray,realize)
 importFrom(Rarr,zarr_overview)
 importFrom(S4Vectors,metadata)
 importFrom(SingleCellExperiment,int_colData)
 importFrom(SingleCellExperiment,int_metadata)
 importFrom(SpatialData,channels)
+importFrom(SpatialData,data)
 importFrom(SpatialData,getZarrArrayPath)
+importFrom(SpatialData,pointNames)
+importFrom(SpatialData,points)
+importFrom(SpatialData,shapeNames)
+importFrom(SpatialData,shapes)
 importFrom(dplyr,mutate)
 importFrom(dplyr,select)
 importFrom(ggforce,geom_circle)

R/plotImage.R

@@ -81,24 +81,27 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme
     if (length(ch) > (n <- length(.DEFAULT_COLORS)) && is.null(c))
         stop("Only ", n, " default colors available, but",
             length(ch), " are needed; please specify 'c'")
-    if (!is.null(c) || (is.null(c) && length(ch) > 1)) {
-        if (is.null(c)) c <- .DEFAULT_COLORS[seq_along(ch)] 
-        c <- col2rgb(c)/255
-        b <- array(0, dim=c(3, dim(a)[-1]))
-        for (i in seq_len(d)) {
-            for (j in seq_len(3)) {
-                rgb <- a[i,,,drop=FALSE]*c[j,i]
-                # apply upper contrast lim.
-                rgb <- rgb*(1/cl[[i]][2]) 
-                b[j,,] <- b[j,,,drop=FALSE] + rgb
-                # apply lower contrast lim.
-                b[j,,][b[j,,] < cl[[i]][1]] <- 0
-            }
+    if (length(ch) == 1) a <- a[rep(1, 3), , ]
+    if (is.null(c)) {
+        c <- .DEFAULT_COLORS[seq_along(ch)] 
+    } else if (length(c) < length(ch)) {
+        stop("not enough colors supplied; need ", length(ch))
+    } else if (length(ch) < length(c)) {
+        warning("too many colors supplied; using first ", length(ch))
+    }
+    c <- col2rgb(c)/255
+    b <- array(0, dim=c(3, dim(a)[-1]))
+    for (i in seq_len(d)) {
+        for (j in seq_len(3)) {
+            rgb <- a[i,,,drop=FALSE]*c[j,i]
+            # apply upper contrast lim.
+            rgb <- rgb*(1/cl[[i]][2]) 
+            b[j,,] <- b[j,,,drop=FALSE] + rgb
+            # apply lower contrast lim.
+            b[j,,][b[j,,] < cl[[i]][1]] <- 0
         }
-        a <- pmin(b, 1)
-    } else {
-        a <- a[rep(1, 3), , ]
     }
+    a <- pmin(b, 1)
     return(a)
 }
 
@@ -115,14 +118,13 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme
 # normalize the image data given its data type
 #' @noRd
 .norm_ia <- \(a, dt) {
-    d <- dim(a)[1]
     if (dt %in% names(.DTYPE_MAX_VALUES)) {
         a <- a / .DTYPE_MAX_VALUES[dt]
     } else if (max(a) > 1) {
-        for (i in seq_len(d))
+        for (i in seq_len(dim(a)[1]))
             a[i,,] <- a[i,,] / max(a[i,,])
     }
-  return(a)
+    return(a)
 }
 
 # check if an image is RGB or not

R/plotShape.R

@@ -67,7 +67,14 @@ setMethod("plotShape", "SpatialData", \(x, i=1, c=NULL, f="white", s="radius", a
                 if (c %in% names(df)) {
                     aes$colour <- aes(.data[[c]])[[1]]
                 } else {
-                    df[[c]] <- valTable(x, i, c, assay=assay)
+                    t <- getTable(x, i)
+                    md <- int_metadata(t)
+                    md <- md$spatialdata_attrs
+                    ik <- md$instance_key
+                    val <- valTable(x, i, c, assay=assay)
+                    idx <- match(df[[ik]], names(val))
+                    df[[c]] <- val[idx]
+                    #df[[c]] <- valTable(x, i, c, assay=assay)
                     if (scale_type(df[[c]]) == "discrete")
                         df[[c]] <- factor(df[[c]])
                     aes$colour <- aes(.data[[c]])[[1]]
@@ -93,7 +100,13 @@ setMethod("plotShape", "SpatialData", \(x, i=1, c=NULL, f="white", s="radius", a
             } else if (.str_is_col(c)) {
                 dot$colour <- c
             } else if (is.character(c)) {
-                df[[c]] <- valTable(x, i, c, assay=assay)
+                t <- getTable(x, i)
+                md <- int_metadata(t)
+                md <- md$spatialdata_attrs
+                ik <- md$instance_key
+                val <- valTable(x, i, c, assay=assay)
+                idx <- match(df[[c]][[ik]], names(val))
+                df[[c]] <- val[idx]
                 if (scale_type(df[[c]]) == "discrete")
                     df[[c]] <- factor(df[[c]])
                 aes$colour <- aes(.data[[c]])[[1]]

R/use_geoms.R

@@ -0,0 +1,61 @@
+# functions here emphasize use of the coordinate data
+
+# shape rendering support
+# could transition to S4 if needed
+
+#' @importFrom sf st_as_sf
+#' @importFrom SpatialData data shapes shapeNames
+.shapes2sf <- function(sdobj, elem) {
+    stopifnot(elem %in% shapeNames(sdobj))
+    st_as_sf(data(shapes(sdobj)[[elem]]))
+}
+
+#' @importFrom SpatialData data points pointNames
+.txdf <- function(sdobj) {
+    stopifnot("transcripts" %in% pointNames(sdobj))
+    as.data.frame(data(points(sdobj)$transcripts))
+}
+
+#' @importFrom SpatialData data points pointNames
+.pointdf <- function(sdobj, elem) {
+    stopifnot(elem %in% pointNames(sdobj))
+    as.data.frame(data(points(sdobj)[[elem]]))
+}
+
+.available_transcripts <- function(sdobj) { # maybe too specific?  'points'?
+    txdf <- .txdf(sdobj)
+    as.character(unique(txdf$feature_name)) # valid?  feature_name comes back as *factor*
+}
+
+#' Use geom_sf to view a shapes component
+#' @import ggplot2
+#' @param sdobj SpatialData instance
+#' @param elem character(1) name of a shapes component of sdobj
+#' @export
+viewShape <- function(sdobj, elem) {
+    thesf <- .shapes2sf(sdobj, elem)
+    ggplot2::ggplot(thesf) + ggplot2::geom_sf()
+}
+
+#' Use geom_point to enhance a visualization with viewShape
+#' @param sdobj SpatialData instance
+#' @param featurename character(1) name of a shapes component of sdobj
+#' @param size numeric(1) target size for glyph
+#' @examples
+#' example(use_sdio) # produces br2fov
+#' viewShape(br2fov, "cell_boundaries") + add_tx(br2fov, "EPCAM")
+#' @export
+add_tx <- function(sdobj, featurename, size=.1) {
+    txdf <- .txdf(sdobj) |> dplyr::filter(feature_name == featurename)
+    ggplot2::geom_point(data=txdf, aes(x=x, y=y), size=size)
+}
+
+#' Use geom_point more generally than add_tx
+#' @param sdobj SpatialData instance
+#' @param featurename character(1) name of a shapes component of sdobj
+#' @param size numeric(1) target size for glyph
+#' @export
+add_points <- function(sdobj, featurename, size=.1) {
+    pointdf <- .pointdf(sdobj) 
+    ggplot2::geom_point(data=pointdf, aes(x=x, y=y), size=size)
+}

_extensions/quarto-ext/fontawesome/_extension.yml

@@ -0,0 +1,7 @@
+title: Font Awesome support
+author: Carlos Scheidegger
+version: 1.2.0
+quarto-required: ">=1.2.269"
+contributes:
+  shortcodes:
+    - fontawesome.lua