Cleanup of plotLabel()

DESCRIPTION

@@ -67,8 +67,8 @@ biocViews:
     GeneExpression, 
     Transcriptomics
 License: Artistic-2.0
-RoxygenNote: 7.3.3
 Encoding: UTF-8
 VignetteBuilder: knitr
 URL: https://github.com/HelenaLC/SpatialData.plot
 BugReports: https://github.com/HelenaLC/SpatialData.plot/issues
+Config/roxygen2/version: 8.0.0

NAMESPACE

@@ -25,8 +25,8 @@ importFrom(ggplot2,element_line)
 importFrom(ggplot2,element_text)
 importFrom(ggplot2,geom_blank)
 importFrom(ggplot2,geom_point)
-importFrom(ggplot2,geom_raster)
 importFrom(ggplot2,geom_sf)
+importFrom(ggplot2,geom_tile)
 importFrom(ggplot2,ggplot)
 importFrom(ggplot2,guide_legend)
 importFrom(ggplot2,guides)

R/plotImage.R

@@ -178,11 +178,8 @@ NULL
     list(w=df[, 1], h=df[, 2])
 }
 
-#' @importFrom ggplot2 guides geom_point 
-#'   geom_blank annotation_raster 
-#'   scale_color_identity
-#'   scale_x_continuous
-#'   scale_y_reverse
+#' @importFrom ggplot2 guides geom_point geom_blank annotation_raster 
+#' @importFrom ggplot2 scale_color_identity scale_x_continuous scale_y_reverse
 .gg_i <- \(x, w, h, pal=NULL) {
     l <- if (!is.null(names(pal))) list(
         guides(col=guide_legend(override.aes=list(alpha=1, size=2))),

R/plotLabel.R

@@ -18,8 +18,7 @@
 #' @param nan character string; color for missing values (hidden by default).
 #' 
 #' @examples
-#' x <- file.path("extdata", "blobs.zarr")
-#' x <- system.file(x, package="SpatialData")
+#' x <- system.file("extdata", "blobs.zarr", package="SpatialData")
 #' x <- readSpatialData(x)
 #' 
 #' i <- "blobs_labels"
@@ -49,23 +48,27 @@ NULL
 #' @importFrom S4Vectors metadata
 #' @importFrom rlang .data
 #' @importFrom methods as
-#' @importFrom ggplot2 
-#'   scale_fill_manual scale_fill_gradientn
-#'   aes geom_raster theme unit guides guide_legend
+#' @importFrom ggplot2 scale_fill_manual scale_fill_gradientn
+#' @importFrom ggplot2 aes theme unit guides guide_legend geom_tile
+#'   
 #' @importFrom SingleCellExperiment colData
 #' @export
 setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, 
     a=0.5, pal=c("red", "green"), nan=NA, assay=1) {
     if (is.numeric(i)) i <- labelNames(x)[i]
     i <- match.arg(i, labelNames(x))
     y <- label(x, i)
-    ym <- as.matrix(.get_multiscale_data(label(x, i), k))
-    df <- data.frame(x=c(col(ym)), y=c(row(ym)), z=c(ym))
     # transformation
     if (is.numeric(j))
       j <- CTname(y)[j]
-    ts <- CTpath(x, i, j)
-    df[,c("x", "y")] <- .trans_xy(df[,c("x", "y")], ts)
+    y <- transform(y, j)
+    ym <- .get_multiscale_data(y, k)
+    wh <- .get_wh(y)
+
+    # Keep only indices != 0 since labels might be sparse and thus save memory by not plotting all pixels
+    idx <- BiocGenerics::which(ym != 0L, arr.ind=TRUE)
+    # All other SD elements are flipped when plotted. Let's keep the same convention here.
+    df <- data.frame(x=idx[,2L]+wh$w[1], y=idx[,1L]+wh$h[1], z=ym[idx])
     aes <- aes(.data[["x"]], .data[["y"]])
     if (!is.null(c)) {
         stopifnot(length(c) == 1, is.character(c))
@@ -83,24 +86,23 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL,
         df$z <- getTable(x, i, c, assay=assay)[idx]
         if (c == ik) df$z <- factor(df$z)
         aes$fill <- aes(.data[["z"]])[[1]]
-        switch(scale_type(df$z), 
+        thm <- switch(scale_type(df$z), 
             discrete={
-                val <- sort(setdiff(unique(df$z), NA))
+                val <- sort(unique(df$z), na.last=NA)
                 pal <- colorRampPalette(pal)(length(val))
-                thm <- list(
+                list(
                     theme(legend.key.size=unit(0.5, "lines")),
                     guides(fill=guide_legend(override.aes=list(alpha=1))),
                     scale_fill_manual(c, values=pal, breaks=val, na.value=nan))
             },
-            continuous=thm <- list(
+            continuous=list(
                 theme(legend.key.size=unit(0.5, "lines")),
                 scale_fill_gradientn(c, colors=pal, na.value=nan)))
     } else {
-        thm <- guides(fill="none")
         aes$fill <- aes(.data$z != 0)[[1]]
         thm <- list(
             theme(legend.position="none"),
             scale_fill_manual(NULL, values=pal))
     }
-    list(thm, do.call(geom_raster, list(data=df, mapping=aes, alpha=a)))
+    list(thm, do.call(geom_tile, list(data=df, mapping=aes, alpha=a)))
 })