code cleaning

Author: HelenaLC

NAMESPACE

@@ -3,7 +3,6 @@
 export(plotSpatialData)
 export(scalebar)
 exportMethods(plotImage)
-exportMethods(plotLabel)
 exportMethods(plotPoint)
 exportMethods(plotShape)
 import(spatialdataR)

R/plotImage.R

@@ -161,26 +161,26 @@ NULL
 #' @importFrom spatialdataR data_type
 .df_i <- \(x, k=NULL, ch=NULL, t=NULL, c=NULL, cl=NULL, z=NULL) {
     a <- .get_ms_data(x, k)
-    axisNames <- axes(x=x, y="name")
+    axisNames <- axes(x, "name")
     # 2D max-projection
     a <- .project(x, a)
     axisNames <- axisNames[axisNames != "z"]
+    ti <- which(axisNames == "t")
+    tn <- length(ti)
     # subset channels and timepoint of interest
-    tidx <- which(axisNames=="t") 
-    if (length(tidx)>0) {
+    if (tn) {
         if (is.null(t)) {
             t <- 1
-        } 
-        if (length(t)>1) {
+        } else if (length(t) > 1) {
             stop("Only a single timepoint can be selected")
         }
     }
     a <- .subset_array_by_axes(a=a, axisNames=axisNames, 
                                c=.ch_idx(x, ch), t=t, drop=FALSE)
     # remove time axis if it exists
-    dim(a) <- dim(a)[axisNames != "t"]
-    if (length(tidx)>0) {
-        axisNames <- axisNames[-tidx]
+    if (tn) {
+        dim(a) <- dim(a)[axisNames != "t"]
+        axisNames <- axisNames[-ti]
     }
     # if no channel axis, add dummy axis
     if (!("c" %in% axisNames)) {

R/plotLabel.R

@@ -45,18 +45,15 @@
 #' 
 #' # coloring by 'assay' data
 #' p + plotLabel(x, i, c="channel_1_sum")
-NULL
-
-#' @rdname plotLabel
-#' @importFrom grDevices hcl.colors colorRampPalette
-#' @importFrom S4Vectors metadata
-#' @importFrom rlang .data
+#' 
 #' @importFrom methods as
+#' @importFrom rlang .data
+#' @importFrom S4Vectors metadata
+#' @importFrom SingleCellExperiment colData
+#' @importFrom grDevices hcl.colors colorRampPalette
 #' @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, t=NULL, c=NULL, 
     a=0.5, pal=NULL, nan=NA, assay=1, z=NULL) {
 

R/scalebar.R

@@ -28,6 +28,7 @@
 #' @importFrom methods is
 #' @export
 scalebar <- function(x, len, col="red", lwd=1, xrel=0.05, yrel=0.05) {
+    # validity
     if (!is(x, "SpatialDataArray")) 
         stop("'x' should be a 'SpatialDataArray' object, i.e., an",
             " image or label element from a 'SpatialData' object")

R/utils.R

@@ -1,4 +1,5 @@
-# convenience functions until this is fixed/exported by 'SpatialData'
+# internal helper for null-coalescing
+`%||%` <- \(a, b) if (is.null(a)) b else a
 
 #' @importFrom methods is
 #' @importFrom SingleCellExperiment int_metadata
@@ -65,19 +66,16 @@
 .project <- \(x, y, z=NULL) {
     # max-projection over z-stacks
     axisNames <- axes(x, y="name")
-    zidx <- which(axisNames=="z")
-    if (length(zidx)>0) {
+    zidx <- which(axisNames == "z")
+    if (length(zidx) > 0) {
         if (is.null(z)) {
             # max-projection across z-slices
             y <- apply(y, seq_along(dim(x))[-zidx], max)
         } else {
-            if (length(z)>1) {
-                stop("Only a single z-plane can be selected")
-            }
+            if (length(z) > 1) stop("only a single z-plane can be selected")
             # subset target z-slice
-            y <- .subset_array_by_axes(a=y, axisNames=axisNames, 
-                                       z=z, drop=FALSE)
-            dim(y) <- dim(y)[axisNames!="z"]
+            y <- .subset_array_by_axes(a=y, axisNames=axisNames, z=z, drop=FALSE)
+            dim(y) <- dim(y)[axisNames != "z"]
         }
     }
     y
@@ -116,9 +114,9 @@
 }
 
 .subset_array_by_axes <- \(a, axisNames, ..., drop=FALSE) {
-    if (length(dim(a)) != length(axisNames)) {
-        stop("axisNames must have the same length as the number of dimensions of x")
-    }
+    # this should never be trigger as object validity should prevent it
+    ok <- length(dim(a)) == length(axisNames)
+    if (!ok) stop("'length(axes(x))' must equal 'length(dim(x))'")
     specs <- list(...)
     idx <- lapply(axisNames, \(nm) {
         if (!is.null(specs[[nm]])) {
@@ -130,49 +128,4 @@
     do.call("[", c(list(a), idx, list(drop=drop)))
 }
 
-.unit_map <- c(micrometer="\U03BCm",
-               micron="\U03BCm")
-
-#' Create scalebar for image
-#' 
-#' @param x A \code{SpatialDataArray} object.
-#' @param l A numeric scalar giving the length of the scalebar (in global 
-#'     coordinates). The unit will be extracted from the metadata of \code{x}.
-#' @param xrel,yrel Numeric scalars between 0 and 1 indicating the relative 
-#'     x and y position of the scalebar.
-#' @param color Character scalar indicating the color to use for the scalebar.
-#' @param linewidth Numeric scalar indicating the line width to use for the 
-#'     scalebar.
-#'
-#' @examples
-#' x <- file.path("extdata", "blobs.zarr")
-#' x <- system.file(x, package="spatialdataR")
-#' x <- readSpatialData(x, tables=FALSE)
-#' plotSpatialData() + 
-#'     plotImage(x, i=2) + 
-#'     scalebar(image(x, i=2), l=10)
-#' 
-#' @importFrom ggplot2 annotate
-#' @export
-scalebar <- function(x, l, xrel=0.05, yrel=0.05, 
-                     color="red", linewidth=1) {
-    unit <- axes(x)[[which(axes(x, y="name")=="x")]]$unit
-    if (unit %in% names(.unit_map)) {
-        unit <- .unit_map[unit]
-    }
-    wh <- .get_wh(x)
-    if (xrel<=0.5) {
-        xmin <- diff(wh$w) * xrel + wh$w[1]
-        xmax <- diff(wh$w) * xrel + wh$w[1] + l
-    } else {
-        xmin <- wh$w[2] - diff(wh$w) * (1 - xrel) - l
-        xmax <- wh$w[2] - diff(wh$w) * (1 - xrel)
-    }
-    y <- wh$h[2] - diff(wh$h) * yrel
-    list(annotate(geom="segment", x=xmin, xend=xmax, y=y, yend=y,
-                  color=color, linewidth=linewidth),
-         annotate(geom="text", x=(xmin+xmax)/2, y=y, 
-                  vjust=ifelse(yrel>0.5,1.5,-0.5),
-                  color=color, label=paste0(l, unit)))
-}
-
+.unit_map <- c(micrometer="\U03BCm", micron="\U03BCm")