plot label draft

Author: HelenaLC

NAMESPACE

@@ -18,6 +18,7 @@ export(sd_osn_list)
 export(sd_osn_load)
 export(sd_plot)
 export(sd_plot_image)
+export(sd_plot_label)
 export(sd_plot_point)
 export(sd_plot_shape)
 export(sdio_list)

R/plot-image.R

@@ -17,7 +17,7 @@
 #' @importFrom DelayedArray realize
 #' @export
 sd_plot_image <- \(x, i=1, k=NULL, c=NULL, ch=NULL, cl=NULL, w=800, h=800) {
-    x <- sd; i <- 1; w=h=800; ch <- cl <- c <- k <- NULL; ch <- 2
+    #x <- sd; i <- 1; w=h=800; ch <- cl <- c <- k <- NULL; ch <- 2
     ia <- x@images[[i]]
     ch <- .ch_idx(ia, ch)
     if (is.null(k)) 

R/plot-label.R

@@ -0,0 +1,41 @@
+#' @name sd_plot_label
+#' @title Plot `LabelArray`
+#' 
+#' @examples
+#' pa <- file.path("extdata", "blobs.zarr")
+#' pa <- system.file(pa, package="SpatialData")
+#' sd <- readSpatialData(pa)
+#' 
+#' devtools::load_all()
+#' sd_plot() + sd_plot_label(sd)
+#' 
+#' @importFrom methods as
+#' @importFrom grDevices rgb
+#' @importFrom DelayedArray realize
+#' @export
+sd_plot_label <- \(x, i=1, k=NULL, c=NULL, w=800, h=800) {
+    #x <- sd; i <- 1; w=h=800; c <- k <- NULL; ch <- 2
+    la <- x@labels[[i]]
+    if (is.null(k)) 
+        k <- .guess_scale(la, w, h)
+    a <- data(la, k)
+    dt <- .get_dt(la)
+    a <- as(a, "DelayedArray")
+    dim(a) <- c(1, dim(a))
+    n <- length(setdiff(unique(c(a)), 0))
+    a <- do.call(arbind, replicate(n, a))
+    a <- .norm_ia(realize(a), dt)
+    a <- .chs2rgb(a, 5, c)
+    a <- apply(a, c(2, 3), \(.) do.call(rgb, as.list(.))) 
+    w <- c(0, dim(ia)[3])
+    h <- c(0, dim(ia)[2])
+    # TODO: coloring by value?
+    pal <- NULL
+    lgd <- if (!is.null(pal)) list(
+        guides(col=guide_legend(override.aes=list(alpha=1, size=2))),
+        scale_color_identity(NULL, guide="legend", labels=names(pal)),
+        geom_point(aes(col=.data$foo), data.frame(foo=pal), x=0, y=0, alpha=0))
+    list(lgd,
+        scale_x_continuous(limits=w), scale_y_reverse(limits=rev(h)),
+        annotation_raster(a, w[2],w[1], h[1],h[2], interpolate=FALSE))
+}

R/plot.R

@@ -19,6 +19,7 @@
 #'
 #' @seealso
 #' \code{\link{sd_plot_image}}
+#' \code{\link{sd_plot_label}}
 #' \code{\link{sd_plot_point}}
 #' \code{\link{sd_plot_shape}}
 #'