diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml deleted file mode 100644 index 13c2168..0000000 --- a/.github/workflows/R-CMD-check.yaml +++ /dev/null @@ -1,50 +0,0 @@ -# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples -# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help -on: - push: - branches: [main, devel] - pull_request: - -name: R-CMD-check.yaml - -permissions: read-all - -jobs: - R-CMD-check: - runs-on: ${{ matrix.config.os }} - - name: ${{ matrix.config.os }} (${{ matrix.config.r }}) - - strategy: - fail-fast: false - matrix: - config: - - {os: macos-latest, r: 'release'} - - {os: windows-latest, r: 'release'} - - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - - {os: ubuntu-latest, r: 'release'} - - env: - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - R_KEEP_PKG_SOURCE: yes - - steps: - - uses: actions/checkout@v6 - - - uses: r-lib/actions/setup-pandoc@v2 - - - uses: r-lib/actions/setup-r@v2 - with: - r-version: ${{ matrix.config.r }} - http-user-agent: ${{ matrix.config.http-user-agent }} - - - uses: r-lib/actions/setup-r-dependencies@v2 - with: - extra-packages: any::rcmdcheck - needs: check - - - uses: r-lib/actions/check-r-package@v2 - with: - upload-snapshots: true - build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' - error-on: '"error"' diff --git a/.github/workflows/r-universe.yaml b/.github/workflows/r-universe.yaml new file mode 100644 index 0000000..2ccd1f5 --- /dev/null +++ b/.github/workflows/r-universe.yaml @@ -0,0 +1,14 @@ +name: Test R-universe + +on: + push: + branches: [main] + pull_request: + +jobs: + build: + name: R-universe testing + uses: r-universe-org/workflows/.github/workflows/build.yml@v3 + with: + universe: bioc + organization: bioconductor \ No newline at end of file diff --git a/.gitignore b/.gitignore index a6cfcaa..a8bd2cf 100644 --- a/.gitignore +++ b/.gitignore @@ -5,3 +5,4 @@ *.Rproj *html docs +tests/testthat/Rplots.pdf diff --git a/DESCRIPTION b/DESCRIPTION index 740b058..fac7b60 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,9 +35,7 @@ Imports: rlang, sf, S4Vectors, - SingleCellExperiment, - Rarr, - ZarrArray + SingleCellExperiment Suggests: BiocStyle, ggnewscale, @@ -47,7 +45,8 @@ Suggests: Rgraphviz, SpatialData.data, testthat, - vdiffr + vdiffr, + ZarrArray Remotes: HelenaLC/spatialdataR, HelenaLC/SpatialData.data diff --git a/NAMESPACE b/NAMESPACE index 459ac95..a7b2842 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,7 @@ # Generated by roxygen2: do not edit by hand export(plotSpatialData) +export(scalebar) exportMethods(plotImage) exportMethods(plotLabel) exportMethods(plotPoint) @@ -14,6 +15,7 @@ importFrom(SingleCellExperiment,int_colData) importFrom(SingleCellExperiment,int_metadata) importFrom(ggforce,geom_circle) importFrom(ggplot2,aes) +importFrom(ggplot2,annotate) importFrom(ggplot2,annotation_raster) importFrom(ggplot2,coord_fixed) importFrom(ggplot2,coord_sf) @@ -38,6 +40,7 @@ importFrom(ggplot2,theme_bw) importFrom(ggplot2,unit) importFrom(grDevices,col2rgb) importFrom(grDevices,colorRampPalette) +importFrom(grDevices,colors) importFrom(grDevices,hcl.colors) importFrom(methods,as) importFrom(methods,is) @@ -46,6 +49,7 @@ importFrom(sf,st_as_sf) importFrom(sf,st_buffer) importFrom(sf,st_coordinates) importFrom(sf,st_geometry_type) +importFrom(spatialdataR,"element<-") importFrom(spatialdataR,channels) importFrom(spatialdataR,data_type) importFrom(spatialdataR,transform) diff --git a/R/plotFrame.R b/R/plotFrame.R index eae4457..38666a2 100644 --- a/R/plotFrame.R +++ b/R/plotFrame.R @@ -4,9 +4,12 @@ #' #' @param x \code{SpatialData} object. #' @param i character string or index; the label element to plot. -#' @param assay character string; in case of \code{c} denoting a row name, -#' specifies which \code{assay} data to use (see \code{\link{valTable}}). +#' @param j index or name of target coordinate system. +#' @param assay character string; in case of \code{c} +#' denoting a row name, specifies which \code{assay} +#' data to use (see \code{\link[spatialdataR]{getTable}}). #' (ignored when \code{x} is a \code{SpatialDataPoint}). +#' @param ... option aesthetic arguments passed \code{geom_sf}. #' #' @examples #' x <- file.path("extdata", "blobs.zarr") @@ -36,25 +39,24 @@ NULL #' @importFrom sf st_as_sf st_coordinates st_geometry_type st_buffer #' @importFrom ggplot2 aes theme scale_type geom_sf coord_sf -#' @importFrom spatialdataR transform +#' @importFrom spatialdataR transform element<- #' @importFrom ggforce geom_circle #' @importFrom methods is #' @importFrom utils tail -.plot <- \(x, y, key=NULL, n=Inf, assay=1, i=1, ...) { +.plot <- \(x, y, key=NULL, n=NULL, assay=1, i=1, ...) { if (is(y, "SpatialDataPoint")) { if (!is.null(key)) { + stopifnot(is.character(key), nchar(key) > 0) fk <- feature_key(y) - y<- dplyr::filter(y, .data[[fk]] %in% key) + y <- dplyr::filter(y, .data[[fk]] %in% key) + if (!length(y)) stop("no instances of specified 'key'(s)") } } - if (is.finite(n)) { + if (!is.null(n)) { + stopifnot(is.numeric(n), length(n) == 1, n > 0) n <- min(length(y), n) y <- y[sample(length(y), n)] - if (is(y, "SpatialDataShape")) { - shape(x, i) <- y - } else { - point(x, i) <- y - } + element(x, i) <- y } df <- st_as_sf(data(y)) aes <- aes() diff --git a/R/plotImage.R b/R/plotImage.R index fdc0540..8d96cec 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -4,10 +4,10 @@ #' #' @description ... #' -#' @param x \code{\link{SpatialData}} object. +#' @param x \code{\link[spatialdataR]{SpatialData}} object. #' @param i element to use from a given layer. -#' @param j name of target coordinate system. -#' @param k index of the scale of an image; by default (NULL), will auto-select +#' @param j index or name of target coordinate system. +#' @param k index of the scale to render; by default (NULL), will auto-select #' scale in order to minimize memory-usage and blurring for a target size of #' 800 x 800px; use Inf to plot the lowest resolution available. #' @param ch image channel(s) to be used for plotting (defaults to @@ -18,6 +18,8 @@ #' specifies channel-wise contrast limits - defaults to [0, 1] for all #' (ignored when \code{image(x, i)} is an RGB image; #' for convenience, any NULL = [0, 1], and n = [0, n]). +#' @param t,z integer scalar to indicate a specific time- or z-slice; +#' if left unspecified (default NULL), will perform a max-projection. #' #' @return ggplot #' @@ -84,7 +86,7 @@ NULL n <- length(c) if (n < d) stop( "Only ", n, " default colors available, ", - "but", d, " are needed; please specify 'c'") + "but ", d, " are needed; please specify 'c'") c <- c[seq_len(d)] } } @@ -117,8 +119,8 @@ NULL if (dt %in% names(.DTYPE_MAX_VALUES)) { a <- a / .DTYPE_MAX_VALUES[dt] } else if (max(a) > 1) { - for (i in seq_len(d)) - a[i,,] <- a[i,,] / max(a[i,,]) + maxs <- apply(a, 1, max) + a <- sweep(a, MARGIN = 1, STATS = maxs, FUN = "/") } return(a) } @@ -159,17 +161,40 @@ NULL #' @importFrom methods as #' @importFrom DelayedArray realize #' @importFrom spatialdataR data_type -.df_i <- \(x, k=NULL, ch=NULL, c=NULL, cl=NULL) { +.df_i <- \(x, k=NULL, ch=NULL, t=NULL, c=NULL, cl=NULL, z=NULL) { a <- .get_ms_data(x, k) + axisNames <- axes(x, "name") # 2D max-projection a <- .project(x, a) - # subset channels of interest - a <- a[.ch_idx(x, ch),,,drop=FALSE] + axisNames <- axisNames[axisNames != "z"] + ti <- which(axisNames == "t") + tn <- length(ti) + # subset channels and timepoint of interest + if (tn) { + if (is.null(t)) { + 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 + if (tn) { + dim(a) <- dim(a)[axisNames != "t"] + axisNames <- axisNames[-ti] + } + # if no channel axis, add dummy axis + if (!("c" %in% axisNames)) { + dim(a) <- c(1, dim(a)) + axisNames <- c("c", axisNames) + } a <- .norm_ia(a, data_type(x)) # color merging & contrasts a <- .prep_ia(a, c, cl) } +#' @importFrom rlang .data #' @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) { @@ -177,7 +202,7 @@ NULL guides(col=guide_legend(override.aes=list(alpha=1, size=2))), geom_point(aes(col=.data$foo), data.frame(foo=pal), x=0, y=0, alpha=0)) list(l, - geom_blank(aes(x=x, y=y), data.frame(x=w, y=h)), + geom_blank(aes(x=.data$x, y=.data$y), data.frame(x=w, y=h)), annotation_raster(x, w[1],w[2], h[2],h[1], interpolate=FALSE), scale_color_identity(NULL, guide="legend", breaks=pal, labels=names(pal)), ggnewscale::new_scale_color()) @@ -185,7 +210,7 @@ NULL #' @rdname plotImage #' @export -setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, cl=NULL) { +setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, cl=NULL, t=NULL, z=NULL) { if (is.numeric(i)) i <- imageNames(x)[i] y <- image(x, i) @@ -197,7 +222,7 @@ setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, cl ch <- ch %||% channels(y) cl <- cl %||% c(0, 1/3) } - df <- .df_i(y, k, ch, c, cl) + df <- .df_i(y, k, ch, t, c, cl, z) pal <- c %||% .DEFAULT_COLORS if (dim(y)[1] > 1 && !.is_rgb(y)) { nms <- unlist(channels(y))[idx <- .ch_idx(y, ch)] diff --git a/R/plotLabel.R b/R/plotLabel.R index 7613a81..ce4fbe0 100644 --- a/R/plotLabel.R +++ b/R/plotLabel.R @@ -3,26 +3,24 @@ #' #' @param x \code{SpatialData} object. #' @param i character string or index; the label element to plot. -#' @param j name of target coordinate system. -#' @param k index of the scale of an image; by default (NULL), will auto-select -#' scale in order to minimize memory-usage and blurring for a target size of -#' 800 x 800px; use Inf to plot the lowest resolution available. -#' @param c the default, NULL, gives a binary image of whether or not -#' a given pixel is non-zero; alternatively, a character string specifying -#' a \code{colData} column or row name in a \code{table} annotating \code{i}. -#' @param assay character string; in case of \code{c} denoting a row name, -#' specifies which \code{assay} data to use (see \code{\link{valTable}}). +#' @param c determines label colors; +#' the default (NULL), gives a binary image of whether or not a +#' pixel is non-zero; alternatively, a character string specifying +#' a \code{colData} column or row name in an annotation \code{table}. +#' @param assay character string; +#' in case of \code{c} denoting a row name, +#' specifies which \code{assay} data to use +#' (see \code{\link[spatialdataR]{getTable}}). #' @param a scalar numeric in [0, 1]; alpha value passed to \code{geom_tile}. #' @param pal character vector; color for discrete/continuous values #' (interpolated automatically when insufficient values are provided). #' When left unspecified, color will be sampled at random. #' @param nan character string; color for missing values (hidden by default). -#' @param z scalar integer; -#' specifies which z-slice to plot when \code{label(x, i)} is 3D; -#' by default (NULL), will apply a max-projection across all z-slices. +#' @inheritParams plotImage #' #' @examples -#' x <- system.file("extdata", "blobs.zarr", package="spatialdataR") +#' x <- file.path("extdata", "blobs.zarr") +#' x <- system.file(x, package="spatialdataR") #' x <- readSpatialData(x) #' #' i <- "blobs_labels" @@ -37,34 +35,31 @@ #' table(x) <- t #' #' # coloring by 'colData' -#' n <- length(unique(t$id)) -#' -#' # pal <- hcl.colors(n, "Spectral") -#' pal_d <- hcl.colors(10, "Spectral") -#' p + plotLabel(x, i, c="id", pal=pal_d) +#' p + plotLabel(x, i, c="id") #' #' # coloring by 'assay' data -#' p + plotLabel(x, i, c="channel_1_sum") +#' p + plotLabel(x, i, +#' c="channel_1_sum", +#' pal=c("lavender", "blue")) NULL +#' @export #' @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 colors 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, c=NULL, - a=0.5, pal=NULL, nan=NA, assay=1, z=NULL) { + a=0.5, pal=NULL, nan=NA, assay=1, t=NULL, z=NULL) { if (!is.null(z)) { ok <- length(z) == 1 && is.numeric(z) && z == round(z) && z > 0 if (!ok) stop("invalid 'z'; should be a scalar integer > 0") } - + if (is.numeric(i)) i <- labelNames(x)[i] i <- match.arg(i, labelNames(x)) y <- label(x, i) @@ -76,8 +71,24 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, # get array data ym <- .get_ms_data(y, k) + axisNames <- axes(x=y, y="name") ym <- .project(y, ym, z) - + axisNames <- axisNames[axisNames != "z"] + # subset to selected time + tidx <- which(axisNames=="t") + if (length(tidx)>0) { + if (is.null(t)) { + t <- 1 + } + if (length(t)>1) { + stop("Only a single timepoint can be selected") + } + ym <- .subset_array_by_axes(a=ym, axisNames=axisNames, + t=t, drop=FALSE) + dim(ym) <- dim(ym)[axisNames!="t"] + axisNames <- axisNames[-tidx] + } + # 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) @@ -94,9 +105,10 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, y=wh$h[1]+idx[,1L]*sy, z=ym[idx]) - aes <- aes(.data[["x"]], .data[["y"]]) + aes <- aes(.data$x, .data$y) if (!is.null(c)) { stopifnot(length(c) == 1, is.character(c)) + if (is.null(pal)) pal <- hcl.colors(12, "Spectral") se <- getTable(x, i) is <- instances(se) ik <- instance_key(se) diff --git a/R/scalebar.R b/R/scalebar.R new file mode 100644 index 0000000..5d3143e --- /dev/null +++ b/R/scalebar.R @@ -0,0 +1,67 @@ +#' @title \code{SpatialDataArray} scalebar +#' +#' @param x a \code{SpatialDataArray} object (i.e., +#' image or label element from a \code{SpatialData} object). +#' @param len scalar numeric giving the length of the scalebar +#' in physical coordinate space; the unit will be extracted +#' from the data's Zarr specifications (see \code{axes(x)}). +#' @param col string indicating the color to use for the scalebar. +#' @param lwd scalar numeric indicating the linewidth to use for the scalebar. +#' @param xrel,yrel scalar numeric indicating relative position of the scalebar. +#' +#' @examples +#' zs <- file.path("extdata", "blobs.zarr") +#' zs <- system.file(zs, package="spatialdataR") +#' sd <- readSpatialData(zs, tables=FALSE) +#' +#' # mock unit (data misses specification!) +#' md <- meta(image(sd, 2)) +#' md$multiscales[[1]]$axes[[3]]$unit <- "micron" +#' sd$images[[2]]@meta <- md +#' +#' plotSpatialData() + +#' plotImage(sd, i=2) + +#' scalebar(image(sd, i=2), len=10) +#' +#' @importFrom ggplot2 annotate +#' @importFrom methods is +#' @export +scalebar <- function(x, len=NULL, 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") + ok <- \(x) is.numeric(x) && is.finite(x) && length(x) == 1 + if (!is.null(len)) stopifnot(ok(len), len > 0) + stopifnot(ok(xrel), ok(yrel)) + + xi <- which(axes(x, "name") == "x") + unit <- axes(x)[[xi]]$unit + if (is.null(unit)) + stop("'axes(x)' list element ", xi, + " (X dimension) missing 'unit'") + if (unit %in% names(.unit_map)) + unit <- .unit_map[unit] + + wh <- .get_wh(x) + if (is.null(len)) len <- 0.05*diff(wh$w) + if (xrel <= 0.5) { + xmin <- diff(wh$w) * xrel + wh$w[1] + xmax <- diff(wh$w) * xrel + wh$w[1] + len + } else { + xmin <- wh$w[2] - diff(wh$w) * (1 - xrel) - len + xmax <- wh$w[2] - diff(wh$w) * (1 - xrel) + } + y <- wh$h[2] - diff(wh$h) * yrel + + line <- annotate( + geom="segment", + color=col, linewidth=lwd, + x=xmin, xend=xmax, y=y, yend=y) + text <- annotate( + geom="text", + x=(xmin+xmax)/2, y=y, + vjust=ifelse(yrel > 0.5, 1.5, -0.5), + color=col, label=paste0(round(len, 1), unit)) + return(list(line, text)) +} diff --git a/R/utils.R b/R/utils.R index e5499d0..1a5e1c7 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,23 +1,5 @@ -# convenience functions until this is fixed/exported by 'SpatialData' - -#' @importFrom methods is -#' @importFrom SingleCellExperiment int_metadata -.spatialdata_attrs <- \(x) { - if (is(x, "SingleCellExperiment")) { - int_metadata(x)$spatialdata_attrs - } else if (is(x, "SpatialDataElement")) { - meta(x)$spatialdata_attrs - } else if (is(x, "Zattrs")) { - x$spatialdata_attrs - } else stop("invalid 'x'") -} - -.instance_key <- \(x) .spatialdata_attrs(x)$instance_key -.region_key <- \(x) .spatialdata_attrs(x)$region_key -.region <- \(x) .spatialdata_attrs(x)$region - -#' @importFrom SingleCellExperiment int_colData -.instance_ids <- \(x) int_colData(x)[[.instance_key(x)]] +# internal helper for null-coalescing +`%||%` <- \(a, b) if (is.null(a)) b else a #' @importFrom grDevices col2rgb .str_is_col <- \(x) !inherits(tryCatch(error=\(e) e, col2rgb(x)), "error") @@ -47,7 +29,7 @@ # guess scale of image or label .guess_scale <- \(x, w, h) { - i <- match(c("y", "x"), vapply(axes(x), \(.) .$name, character(1))) + i <- match(c("y", "x"), axes(x=x, y="name")) d <- vapply(x@data, dim, numeric(length(dim(x)))) d <- apply(d, 2, \(.) sum(abs(.[i]-c(h, w)))) which.min(d) @@ -63,20 +45,21 @@ # y = high-dim. array # z = (optional) index .project <- \(x, y, z=NULL) { - ok <- c("x", "y", "c") - as <- axes(x, "name") - ok <- as %in% ok - if (all(ok)) return(y) # 2D - if (is.null(z)) { # project - y <- apply(y, which(ok), max) - return(y) + # max-projection over z-stacks + axisNames <- axes(x, y="name") + 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") + # subset target z-slice + y <- .subset_array_by_axes(a=y, axisNames=axisNames, z=z, drop=FALSE) + dim(y) <- dim(y)[axisNames != "z"] + } } - # specific slice - i <- !logical(length(as)) - i <- as.list(i) - i[as == "z"] <- z - arg <- c(list(y), i) - do.call(`[`, arg) + y } #' @importFrom utils tail @@ -110,3 +93,20 @@ wh$h[2] <- wh$h[2]*ty return(wh) } + +.subset_array_by_axes <- \(a, axisNames, ..., drop=FALSE) { + # 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]])) { + specs[[nm]] + } else { + seq.int(dim(a)[match(nm, axisNames)]) + } + }) + do.call("[", c(list(a), idx, list(drop=drop))) +} + +.unit_map <- c(micrometer="\U03BCm", micron="\U03BCm") diff --git a/man/plotFrame.Rd b/man/plotFrame.Rd index 148a8c7..2d09b16 100644 --- a/man/plotFrame.Rd +++ b/man/plotFrame.Rd @@ -17,9 +17,14 @@ \item{i}{character string or index; the label element to plot.} -\item{assay}{character string; in case of \code{c} denoting a row name, -specifies which \code{assay} data to use (see \code{\link{valTable}}). +\item{j}{index or name of target coordinate system.} + +\item{assay}{character string; in case of \code{c} +denoting a row name, specifies which \code{assay} +data to use (see \code{\link[spatialdataR]{getTable}}). (ignored when \code{x} is a \code{SpatialDataPoint}).} + +\item{...}{option aesthetic arguments passed \code{geom_sf}.} } \description{ \code{SpatialData} point/shape viz. diff --git a/man/plotImage.Rd b/man/plotImage.Rd index 2461628..dbb2e36 100644 --- a/man/plotImage.Rd +++ b/man/plotImage.Rd @@ -6,18 +6,28 @@ \alias{plotImage,SpatialData-method} \title{\code{SpatialData} image viz.} \usage{ -\S4method{plotImage}{SpatialData}(x, i = 1, j = 1, k = NULL, ch = NULL, c = NULL, cl = NULL) +\S4method{plotImage}{SpatialData}( + x, + i = 1, + j = 1, + k = NULL, + ch = NULL, + c = NULL, + cl = NULL, + t = NULL, + z = NULL +) plotSpatialData() } \arguments{ -\item{x}{\code{\link{SpatialData}} object.} +\item{x}{\code{\link[spatialdataR]{SpatialData}} object.} \item{i}{element to use from a given layer.} -\item{j}{name of target coordinate system.} +\item{j}{index or name of target coordinate system.} -\item{k}{index of the scale of an image; by default (NULL), will auto-select +\item{k}{index of the scale to render; by default (NULL), will auto-select scale in order to minimize memory-usage and blurring for a target size of 800 x 800px; use Inf to plot the lowest resolution available.} @@ -31,6 +41,9 @@ which channels are available for a given \code{SpatialDataImage}} specifies channel-wise contrast limits - defaults to [0, 1] for all (ignored when \code{image(x, i)} is an RGB image; for convenience, any NULL = [0, 1], and n = [0, n]).} + +\item{t, z}{integer scalar to indicate a specific time- or z-slice; +if left unspecified (default NULL), will perform a max-projection.} } \value{ ggplot diff --git a/man/plotLabel.Rd b/man/plotLabel.Rd index 3c4a244..b824651 100644 --- a/man/plotLabel.Rd +++ b/man/plotLabel.Rd @@ -15,6 +15,7 @@ pal = NULL, nan = NA, assay = 1, + t = NULL, z = NULL ) } @@ -23,15 +24,16 @@ \item{i}{character string or index; the label element to plot.} -\item{j}{name of target coordinate system.} +\item{j}{index or name of target coordinate system.} -\item{k}{index of the scale of an image; by default (NULL), will auto-select +\item{k}{index of the scale to render; by default (NULL), will auto-select scale in order to minimize memory-usage and blurring for a target size of 800 x 800px; use Inf to plot the lowest resolution available.} -\item{c}{the default, NULL, gives a binary image of whether or not -a given pixel is non-zero; alternatively, a character string specifying -a \code{colData} column or row name in a \code{table} annotating \code{i}.} +\item{c}{determines label colors; +the default (NULL), gives a binary image of whether or not a +pixel is non-zero; alternatively, a character string specifying +a \code{colData} column or row name in an annotation \code{table}.} \item{a}{scalar numeric in [0, 1]; alpha value passed to \code{geom_tile}.} @@ -41,18 +43,20 @@ When left unspecified, color will be sampled at random.} \item{nan}{character string; color for missing values (hidden by default).} -\item{assay}{character string; in case of \code{c} denoting a row name, -specifies which \code{assay} data to use (see \code{\link{valTable}}).} +\item{assay}{character string; +in case of \code{c} denoting a row name, +specifies which \code{assay} data to use +(see \code{\link[spatialdataR]{getTable}}).} -\item{z}{scalar integer; -specifies which z-slice to plot when \code{label(x, i)} is 3D; -by default (NULL), will apply a max-projection across all z-slices.} +\item{t, z}{integer scalar to indicate a specific time- or z-slice; +if left unspecified (default NULL), will perform a max-projection.} } \description{ \code{SpatialData} label viz. } \examples{ -x <- system.file("extdata", "blobs.zarr", package="spatialdataR") +x <- file.path("extdata", "blobs.zarr") +x <- system.file(x, package="spatialdataR") x <- readSpatialData(x) i <- "blobs_labels" @@ -67,12 +71,10 @@ t$id <- sample(letters, ncol(t)) table(x) <- t # coloring by 'colData' -n <- length(unique(t$id)) - -# pal <- hcl.colors(n, "Spectral") -pal_d <- hcl.colors(10, "Spectral") -p + plotLabel(x, i, c="id", pal=pal_d) +p + plotLabel(x, i, c="id") # coloring by 'assay' data -p + plotLabel(x, i, c="channel_1_sum") +p + plotLabel(x, i, + c="channel_1_sum", + pal=c("lavender", "blue")) } diff --git a/man/scalebar.Rd b/man/scalebar.Rd new file mode 100644 index 0000000..a586a26 --- /dev/null +++ b/man/scalebar.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/scalebar.R +\name{scalebar} +\alias{scalebar} +\title{\code{SpatialDataArray} scalebar} +\usage{ +scalebar(x, len = NULL, col = "red", lwd = 1, xrel = 0.05, yrel = 0.05) +} +\arguments{ +\item{x}{a \code{SpatialDataArray} object (i.e., +image or label element from a \code{SpatialData} object).} + +\item{len}{scalar numeric giving the length of the scalebar +in physical coordinate space; the unit will be extracted +from the data's Zarr specifications (see \code{axes(x)}).} + +\item{col}{string indicating the color to use for the scalebar.} + +\item{lwd}{scalar numeric indicating the linewidth to use for the scalebar.} + +\item{xrel, yrel}{scalar numeric indicating relative position of the scalebar.} +} +\description{ +\code{SpatialDataArray} scalebar +} +\examples{ +zs <- file.path("extdata", "blobs.zarr") +zs <- system.file(zs, package="spatialdataR") +sd <- readSpatialData(zs, tables=FALSE) + +# mock unit (data misses specification!) +md <- meta(image(sd, 2)) +md$multiscales[[1]]$axes[[3]]$unit <- "micron" +sd$images[[2]]@meta <- md + +plotSpatialData() + + plotImage(sd, i=2) + + scalebar(image(sd, i=2), len=10) + +} diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf deleted file mode 100644 index 54f8e39..0000000 Binary files a/tests/testthat/Rplots.pdf and /dev/null differ diff --git a/tests/testthat/_snaps/plotSpatialData/overlays.svg b/tests/testthat/_snaps/plotSpatialData/overlays.svg deleted file mode 100644 index 7679270..0000000 --- a/tests/testthat/_snaps/plotSpatialData/overlays.svg +++ /dev/null @@ -1,2315 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 0 -10 -20 -30 -40 -50 -60 - - - - - - - -y - - - - - - - - 0 -10 -20 -30 -40 -50 -60 -x -layered - - - - - - - - - - - - - 0 -10 -20 -30 -40 -50 -60 - - - - - - - -y - - - - - - - - 0 -10 -20 -30 -40 -50 -60 -x -image - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -10 -20 -30 -40 -50 -60 - - - - - - -y - - - - - - -10 -20 -30 -40 -50 -60 -x -labels - - - - - - - - - - - - - - - - -20 -25 -30 -35 -40 -45 -50 - - - - - - - - - - - - - - - -15 -20 -25 -30 -35 -40 -45 -50 -circles - - - - - - - - - - - - - - - - -25 -30 -35 -40 -45 -50 -55 - - - - - - - - - - - - - - - -20 -25 -30 -35 -40 -45 -50 -55 -polygons - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -10 -20 -30 -40 -50 -60 - - - - - - - - - - - - -10 -20 -30 -40 -50 -60 -genes - - -gene_a -gene_b -points -overlays - - diff --git a/tests/testthat/test-plotImage.R b/tests/testthat/test-plotImage.R index ea2210b..22907f0 100644 --- a/tests/testthat/test-plotImage.R +++ b/tests/testthat/test-plotImage.R @@ -1,3 +1,4 @@ +require(ggplot2, quietly=TRUE) require(spatialdataR, quietly=TRUE) require(SpatialData.data, quietly=TRUE) @@ -50,41 +51,60 @@ test_that(".check_cl", { expect_error(.check_cl(list(NULL, NULL, 0), 3)) # zero scalar }) -# mock multiplex image -l <- 4; m <- 80; n <- 120 -a <- as(array(runif(l*m*n), c(l,m,n)), "ZarrArray") -y <- SpatialDataImage(list(a), SpatialDataAttrs(type="image", dim=2, nch=l)) -x <- SpatialData(list(y)) +# mock high-dim. image +.mock <- \(c=3, t=0, z=0, y=80, x=120) { + dim <- c(c, t, z, y, x); dim <- dim[dim != 0] + arr <- drop(as(array(runif(prod(dim)), dim), "ZarrArray")) + sda <- SpatialDataAttrs(dim=length(dim)-1, nch=c) + SpatialDataImage(list(arr), sda) +} test_that(".norm_ia", { + a <- data(.mock()) + nch <- dim(a)[1] # valid data type dt <- data_type(a) b <- .norm_ia(realize(a), dt) expect_equal( tolerance=1e-3, apply(b, 1, range), - replicate(l, c(0, 1))) + replicate(nch, c(0, 1))) # invalid data type b <- .norm_ia(realize(a), "") expect_equal( tolerance=1e-3, apply(b, 1, range), - replicate(l, c(0, 1))) + replicate(nch, c(0, 1))) }) -test_that(".prep_ia", { testthat::skip() - dt <- data_type(a) - ch <- seq_len(d <- dim(a)[1]) - a <- .norm_ia(realize(a), dt) +test_that(".prep_ia", { + # insufficient default colors + a <- data(.mock(33)) + expect_error(.prep_ia(a), "default") # no colors, no contrasts - b <- .prep_ia(a, ch) + a <- data(i <- .mock(c=c <- 7)) + b <- .prep_ia(a, seq_len(c)) expect_is(b, "matrix") expect_length(dim(b), 2) + expect_equal(dim(a)[-1], dim(b)) expect_is(b[1,1], "character") # colors - pal <- colors()[seq_len(l)] + pal <- colors()[seq_len(c)] b <- .prep_ia(a, c=pal) + expect_length(dim(b), 2) expect_equal(dim(a)[-1], dim(b)) expect_is(b, "matrix") - expect_is(c(b), "character") + expect_is(b[1,1], "character") +}) + +test_that("plotImage,3/4D", { + f <- \(x, ...) plotImage(SpatialData(images=list(x)), ...) + x <- .mock(c=5, t=3, z=4) + # valid + expect_is(f(x), "list") # project both + expect_is(f(x, t=1), "list") # t-slice + expect_is(f(x, z=1), "list") # z-slice + # invalid + expect_error(f(x, t=4)) + #expect_error(f(x, z=5)) TODO: this is not throwing an error? }) diff --git a/tests/testthat/test-plotLabel.R b/tests/testthat/test-plotLabel.R new file mode 100644 index 0000000..18befeb --- /dev/null +++ b/tests/testthat/test-plotLabel.R @@ -0,0 +1,77 @@ +require(ggplot2, quietly=TRUE) +require(spatialdataR, quietly=TRUE) +require(SingleCellExperiment, quietly=TRUE) + +x <- file.path("extdata", "blobs.zarr") +x <- system.file(x, package="spatialdataR") +x <- readSpatialData(x, tables=FALSE) + +# mock high-dim. label +.mock <- \(t=0, z=0, y=80, x=120) { + dim <- c(t, z, y, x); dim <- dim[dim != 0] + arr <- drop(as(array(sample(prod(dim)), dim), "ZarrArray")) + sda <- SpatialDataAttrs(type="label", dim=length(dim)) + SpatialData(labels=list(SpatialDataLabel(list(arr), sda))) +} + +test_that("invalid plotLabel()", { + # bad element + expect_error(plotLabel(x, i="x")) + expect_error(plotLabel(x, i=123)) + # bad coordinate space + expect_error(plotLabel(x, j="x")) + expect_error(plotLabel(x, j=123)) +}) + +test_that("3/4D plotLabel()", { + x <- .mock(t=2, z=3) + # invalid + expect_error(plotLabel(x, z=4)) + expect_error(plotLabel(x, t=3)) + expect_error(plotLabel(x, t=c(1,2))) + expect_error(plotLabel(x, z=c(2,3))) + # valid + expect_is(plotLabel(x), "list") # project both + expect_is(plotLabel(x, t=1), "list") # t-slice + expect_is(plotLabel(x, z=1), "list") # z-slice + # check data + x <- .mock(t=2, z=3, y=h <- 44, x=w <- 55) + expect_is(l <- plotLabel(x, z=1, t=1), "list") + df <- layer_data(ggplot() + l) + expect_equal(nrow(df), h*w) + expect_is(df$fill, "character") + expect_equal(range(df$x), c(1, w)) + expect_equal(range(df$y), c(1, h)) +}) + +test_that("coloring plotLabel()", { + # mock annotation + ni <- length(id <- instances(label(x))) + df <- DataFrame(id, num=runif(ni), fac=gl(ni, 1)) + mx <- matrix(runif((ng <- 3)*ni), nr=ng) + rownames(mx) <- letters[seq_len(ng)] + se <- SingleCellExperiment(list(mx), colData=df) + y <- setTable(x, labelNames(x)[1], se) + + # continuous (colData) + expect_is(l <- plotLabel(y, c="num"), "list") + p <- ggplot() + l + g <- get_guide_data(p, "fill") + expect_is(g[[2]], "numeric") + # continuous (assay) + expect_is(l <- plotLabel(y, c="a"), "list") + p <- ggplot() + l + g <- get_guide_data(p, "fill") + expect_is(g[[2]], "numeric") + + # discrete + expect_is(l <- plotLabel(y, c="fac"), "list") + p <- ggplot() + l + g <- get_guide_data(p, "fill") + expect_is(g[[2]], "character") + # by instance (default) + expect_is(l <- plotLabel(x), "list") + p <- ggplot() + l + g <- get_guide_data(p, "fill") + expect_is(g[[2]], "character") +}) diff --git a/tests/testthat/test-plotPoint.R b/tests/testthat/test-plotPoint.R index 18ce9ff..eee008a 100644 --- a/tests/testthat/test-plotPoint.R +++ b/tests/testthat/test-plotPoint.R @@ -1,5 +1,6 @@ require(ggplot2, quietly=TRUE) require(spatialdataR, quietly=TRUE) + x <- file.path("extdata", "blobs.zarr") x <- system.file(x, package="spatialdataR") x <- readSpatialData(x, tables=FALSE) @@ -25,3 +26,85 @@ test_that("plotPoint(),SpatialData", { q <- p + plotPoint(x, i, colour="genes") expect_s3_class(q, "ggplot") }) + +test_that("point coloring", { + fk <- feature_key(point(x)) + fs <- unique(point(x)[[fk]]) + expect_is(l <- plotPoint(x, col=fk), "list") + expect_s3_class(p <- ggplot() + l, "ggplot") + expect_is(get_layer_data(p)$colour, "character") + g <- get_guide_data(p, "colour") + expect_setequal(g[[2]], fs) +}) + +test_that("point feature", { + # invalid + expect_error(plotPoint(x, key="")) + expect_error(plotPoint(x, key="x")) + expect_error(plotPoint(x, key=123)) + expect_error(plotPoint(x, key=character(0))) + # single valid + fk <- feature_key(point(x)) + fs <- unique(point(x)[[fk]]) + ks <- sample(fs, 1) + expect_is(l <- plotPoint(x, key=ks), "list") + df <- get_layer_data(ggplot() + l) + expect_equal(nrow(df), sum(point(x)[[fk]] == ks)) + # multiple valid + expect_is(l <- plotPoint(x, key=fs), "list") + df <- get_layer_data(ggplot() + l) + expect_equal(nrow(df), length(point(x))) +}) + +test_that("point downsampling", { + # valid + n <- length(point(x)) + m <- sample(seq(2, n/2), 1) + expect_is(l <- plotPoint(x, n=m), "list") + df <- get_layer_data(ggplot() + l) + expect_equal(nrow(df), m) + # acceptable + expect_no_error(plotPoint(x, n=n+1)) + expect_no_error(plotPoint(x, n=Inf)) + expect_no_error(plotPoint(x, n=NULL)) + # invalid + expect_error(plotPoint(x, n=0)) + expect_error(plotPoint(x, n=-1)) + expect_error(plotPoint(x, n=-Inf)) +}) + +test_that("shape annotation", { + ni <- length(id <- instances(shape(x))) + df <- DataFrame(id, num=runif(ni), fac=gl(ni, 1)) + mx <- matrix(runif((ng <- 3)*ni), nr=ng) + rownames(mx) <- letters[seq_len(ng)] + se <- SingleCellExperiment(list(mx), colData=df) + y <- setTable(x, shapeNames(x)[1], se) + + # continuous (colData) + expect_is(l <- plotShape(y, fill="num"), "list") + p <- ggplot() + l + g <- get_guide_data(p, "fill") + expect_is(g[[2]], "numeric") + # continuous (assay) + expect_is(l <- plotShape(y, fill="a"), "list") + p <- ggplot() + l + g <- get_guide_data(p, "fill") + expect_is(g[[2]], "numeric") + # discrete + expect_is(l <- plotShape(y, fill="fac"), "list") + p <- ggplot() + l + g <- get_guide_data(p, "fill") + expect_is(g[[2]], "character") + + # arbitrary aesthetics + l <- plotShape(y, + fill="fac", color="num", + stroke="num", linetype="fac") + df <- layer_data(ggplot() + l) + expect_equal(df$stroke, se$num) + expect_is(df$fill, "character") + expect_is(df$colour, "character") + expect_is(df$linetype, "character") + expect_true(df$linetype[1] == "solid") +}) diff --git a/tests/testthat/test-plotSpatialData.R b/tests/testthat/test-plotSpatialData.R index 2f296d9..12c9116 100644 --- a/tests/testthat/test-plotSpatialData.R +++ b/tests/testthat/test-plotSpatialData.R @@ -1,4 +1,4 @@ -test_that("regression test of overlays", { +test_that("regression test of overlays", { skip() zs <- system.file("extdata", "blobs.zarr", package="spatialdataR") x <- readSpatialData(zs) diff --git a/tests/testthat/test-scalebar.R b/tests/testthat/test-scalebar.R new file mode 100644 index 0000000..f35a05e --- /dev/null +++ b/tests/testthat/test-scalebar.R @@ -0,0 +1,82 @@ +require(ggplot2, quietly=TRUE) +x <- file.path("extdata", "blobs.zarr") +x <- system.file(x, package="spatialdataR") +x <- readSpatialData(x, tables=FALSE) + +set_unit <- \(x, dim="x", val="micron") { + y <- meta(x) + i <- which(axes(x, "name") == dim) + y$multiscales[[1]]$axes[[i]]$unit <- val + x@meta <- y + return(x) +} + +test_that("invalid scalebar()", { + # not an image/label + expect_error(scalebar(point(x))) + expect_error(scalebar(shape(x))) + + # missing 'unit' + expect_error(scalebar(image(x))) + y <- set_unit(image(x), "y") + expect_error(scalebar(image(y), 1)) + + # invalid arguments + y <- set_unit(image(x), "x") + v <- c(c(1,1), Inf, TRUE, "") + for (. in v) { + expect_error(scalebar(y, len=.)) + expect_error(scalebar(y, len=1, xrel=.)) + expect_error(scalebar(y, len=1, yrel=.)) + } +}) + +test_that("valid scalebar()", { + # to make tests more challenging, crop image + # to be non-square & offset from the origin + y <- list(xmin=dx <- 16, xmax=64, ymin=0, ymax=48) + y <- set_unit(crop(image(x), y), "x") + + # default 'len' + expect_silent(l <- scalebar(y, len=NULL)) + p <- ggplot() + l + df <- layer_data(p, 1) + expect_equal(df$xend-df$x, 0.05*dim(y)[3]) + + # valid arguments + l <- scalebar(y, + len=len <- 5.1234, + xrel=xrel <- 0.05, + yrel=yrel <- 0.11, + col=col <- "pink", + lwd=lwd <- 7) + expect_is(l, "list") + expect_length(l, 2) + + # check placement + p <- ggplot() + l + df <- layer_data(p, 1) + expect_equal(df$colour, col) + expect_equal(df$linewidth, lwd) + + expect_equal(df$x, dx+dim(y)[3]*xrel) + expect_equal(df$xend, dx+dim(y)[3]*xrel+len) + expect_equal(df$y, dim(y)[2]*(1-yrel)) + expect_equal(df$yend, df$y) + + # flexible 'x/yrel' + l <- scalebar(y, xrel=0, yrel=0) + df <- layer_data(ggplot() + l, 1) + expect_equal(df$x, dx) + expect_equal(df$y, dim(y)[2]) + + l <- scalebar(y, xrel=-1, yrel=-1) + df <- layer_data(ggplot() + l, 1) + expect_equal(df$x, dx-dim(y)[3]) + expect_equal(df$y, 2*dim(y)[2]) + + l <- scalebar(y, xrel=a <- .9, yrel=b <- 1.2) + df <- layer_data(ggplot() + l, 1) + expect_equal(df$xend, dx+a*dim(y)[3]) + expect_equal(df$y, -(b-1)*dim(y)[2]) +})