From 34a1c1d358181d11620773552f54db4d9ccdb6ba Mon Sep 17 00:00:00 2001 From: Artur-man Date: Fri, 9 May 2025 00:37:23 +0200 Subject: [PATCH 1/7] implement multiscale label visualization --- NAMESPACE | 2 +- R/plotImage.R | 15 +-------------- R/plotLabel.R | 6 +++--- R/utils.R | 17 ++++++++++++++++- tests/testthat/Rplots.pdf | Bin 0 -> 4050 bytes tests/testthat/test-plotArray.R | 8 ++++---- 6 files changed, 25 insertions(+), 23 deletions(-) create mode 100644 tests/testthat/Rplots.pdf diff --git a/NAMESPACE b/NAMESPACE index 6ed0af0..6013798 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -27,7 +27,7 @@ importFrom(ggplot2,element_line) importFrom(ggplot2,element_text) importFrom(ggplot2,geom_point) importFrom(ggplot2,geom_polygon) -importFrom(ggplot2,geom_tile) +importFrom(ggplot2,geom_raster) importFrom(ggplot2,ggplot) importFrom(ggplot2,guide_legend) importFrom(ggplot2,guides) diff --git a/R/plotImage.R b/R/plotImage.R index 5df0e01..b78608f 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -159,24 +159,11 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme return(NULL) } -.guess_scale <- \(x, w, h) { - n <- length(dim(x)) - i <- ifelse(n == 3, -1, TRUE) - d <- vapply(x@data, dim, numeric(n)) - d <- apply(d, 2, \(.) sum(abs(.[i]-c(h, w)))) - which.min(d) -} - -.get_img_data <- \(x, k=NULL, w=800, h=800) { - if (!is.null(k)) return(data(x, k)) - data(x, .guess_scale(x, w, h)) -} - #' @importFrom methods as #' @importFrom grDevices rgb #' @importFrom DelayedArray realize .df_i <- \(x, k=NULL, ch=NULL, c=NULL, cl=NULL) { - a <- .get_img_data(x, k) + a <- .get_multiscale_data(x, k) ch <- .ch_idx(x, ch) if (!.is_rgb(x)) a <- a[ch, , , drop=FALSE] diff --git a/R/plotLabel.R b/R/plotLabel.R index d9c61fc..756cc52 100644 --- a/R/plotLabel.R +++ b/R/plotLabel.R @@ -45,13 +45,13 @@ NULL #' @importFrom methods as #' @importFrom ggplot2 #' scale_fill_manual scale_fill_gradientn -#' aes geom_tile theme unit guides guide_legend +#' aes geom_raster theme unit guides guide_legend #' @export setMethod("plotLabel", "SpatialData", \(x, i=1, 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 <- as.matrix(as(data(label(x, i)), "DelayedArray")) + y <- as.matrix(.get_multiscale_data(label(x, i))) df <- data.frame(x=c(col(y)), y=c(row(y)), z=c(y)) aes <- aes(.data[["x"]], .data[["y"]]) if (!is.null(c)) { @@ -81,5 +81,5 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, c=NULL, theme(legend.position="none"), scale_fill_manual(NULL, values=pal)) } - list(thm, do.call(geom_tile, list(data=df, mapping=aes, alpha=a))) + list(thm, do.call(geom_raster, list(data=df, mapping=aes, alpha=a))) }) \ No newline at end of file diff --git a/R/utils.R b/R/utils.R index 7f95287..d56f192 100644 --- a/R/utils.R +++ b/R/utils.R @@ -45,4 +45,19 @@ .DTYPE_MAX_VALUES <- c("uint8" = 255, "uint16" = 65535, "uint32" = 4294967295, - "uint64" = 2^64 - 1) \ No newline at end of file + "uint64" = 2^64 - 1) + +# guess scale of image or label +.guess_scale <- \(x, w, h) { + n <- length(dim(x)) + i <- ifelse(n == 3, -1, TRUE) + d <- vapply(x@data, dim, numeric(n)) + d <- apply(d, 2, \(.) sum(abs(.[i]-c(h, w)))) + which.min(d) +} + +# get multiscale +.get_multiscale_data <- \(x, k=NULL, w=800, h=800) { + if (!is.null(k)) return(data(x, k)) + data(x, .guess_scale(x, w, h)) +} \ No newline at end of file diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf new file mode 100644 index 0000000000000000000000000000000000000000..90b57b60f68501de9f476aa6a4e9e4b6e9d11584 GIT binary patch literal 4050 zcmbtXc|25Y-xnd%B3qg}J*=tuuV=<6du6DCArQ|L4Ti46fLf-V+~)kJHeb&WhAr-{FeF%u= z&1ZrA!3F>wf*240nvmEeD%}?VZArcm3($ZKh`_%cw0?8o+wrZL5RLt}IcP$svEd~P z&|Y;1i4cp5{Q}{%GZ~uKZogbmUpY4C8ib4NhTvsjre`MFfWaUDI zTz(_Vuk*h`|4fzzfL0W57T^Z(>rMptMQB|6OH44 z9zR_ezu@0F!+k-vhuDA{2zMr&2MT0+AV4$tvH*R3xV)fgAluxY&F@BieSQo$50%ce zXOPIN2*@Iu8v~lFB;Z~6{kznBh@Zp_JYZsCOkzRa0G@B<@!f#G`hGkk{?*d>Nk9U0 zfV?{S9ow$uaO#mJ#MLDTJ* zhvXMRk7d{KUiwaR`)UNvu0#pnKjg~5GUF|a zW`gO0Aii>oRKk}BM-ZO0- zZM46de?6)<%wy&9xrGy{p3z}bNP_%ggzUrzr;3Y<;RKF7wG zcxusnf(r-_T02Ggnf;5}m2eg82%67>4c;K<$wL#7=te?VRSWZ#EbD+@8>to|d`Hi~P!U zsyg_!b&FD164{)9t&+6sczLR=8*UpDlDfC{_C1Lz0r6oWK_gV$+T&iB z;YjJTYY2d>ba+M1*7K3YUc0Y}aB?JYQFz8yb_97Cr!A@;(dM;wU=0zyDJxuM2JzT% zbM&d!%`(JTHek{!ck7h%*==uxgiR!D<<75DHZisklrfyhAzqU!iW$%K8FL#$vHz$M z*l1FjW9KKiBoi#U6D?NI;CfSnDqQAeqrEOETDIZg3|3oSJ+kuN1%^<_=Ba3##*4!e z&WQaHg%aVLC3LSOpe454H#1HSR1%X=xN%nUsvyPi`Pm&;<*VZ@k_%hiq(w|kF}4TK zuYV*jb86&DYOZ50KCj45)Hd_lzTU&Vs6P>(B&^MjU1{&?7!zQt>LN1})Xki7E_ZGp zD;txT(_WGhiOMA>Vv@Fo9hBQ8Qzlr3EZf$Tq;m?{oJcAtb^eELpWHiQzAytLEBRRNvI#Il7cBbtEv}hJ0 z9=dLSQnmt0DpBm8(H6#gNNTy~I?c4Ls;mNylq5gJ9eTjH5?&SKd_bR|ZzHE%uWV=G zql8z9P*U($nB1MI_)@VBNO@@HEzZ<;IXGxc+m)>_wEM1I&K~DIYf&@Oj(dAi>^<&w zfdz3+IEOh0_kX07IOhfuj$3@VF6sHu;&kx?JJ)=NJhsETnC^1y;eIn62OX23GG@X@ z;lIqKRh!~QOkUZ=qn1&=D6&Izkqu;D-OK4U8+RGk-e{sxAlyl$cUbMP&Efj-T~F{&_7;^qd3!DB+J`5Wz0aSR z^$uRw=;ikI^j2OExIWZlNJ*naAA9rX`!4MpAK07xliK8_GS2D5jt=xiYqsNd;+*`Z zdgMAY`nvl*_B`q?>ekKsdPd&H7`;_~TkGKHXl-c4_h>thL5V|KR=&_%bak z%ni&oY;61X$HH%G+hf%_w;bAHoFJ00?Vw~&N_ry|N^m)27Gf*jD3^{4#N zyAAbEzeYvnMYZO(le)X^VY*8DK8PeVBgp15QhkT_R7%RHqey70Ph(Wnv6 z*R#)4v1C)pQ>yR0<-7|0!3$pPgOi=HBT|3aPqK!bcv}6HPXZqC2I;4URKm)`&VIvx z+qTAa%|Q6u@au*x_bxkqBBevv(|Vz8^uK zS$x^mwv3CD?s#Q{q$Xt2pKzZ)K! zwYraoO|oOxr7NYMLMPl3Wa3SmwD48bYcJxSqn>G3QKkxttmUl&m1V7pt@c_D(cjYQ z7caCsT{yyhey$w4`8b!#bA0Uhs&C@OK;?FnlR6KSf3f3M9ZQsK{xIpH-o^KKY)MXb zl?gYkZdth^-TOTt+lq>DF30kd#Th5-lf^!h1<#+>2Gy3l|M0BGvGA~y>jJIBYq~x7 z?ox+HUQ9eUjjOY~18=4^AJ)E9Q+*)sdilG?&{v`FBI1O&?MdzJYM0cYV#bZDoR41j z8`_2f!+KseQ*Y18Qx?8*PQnN-g8UG(r5t;oA7HSRvB^W;Le z@?_G)j(vXwmRGjq7rs8(HoYLp*gQbm*sUuwu|V+ z%Ei`zdLC2AEUl1{_~i>dPIV<&wObgI-K{IhuO{rC(g!W76zU$lo2>4-_~lCr+d^?)Noe)@s3>>Yglc<|66TZfRsk{bm{co{b`|NpSR9^m?})P$qp4-h@M^kZOX>{ ztiJxGcT8!pxS-Hr!NZ?h|Gjde(2Qs-%69+(5-2`C5G-=|D#i`KX@dR~8ixhw;KAb@ zIvb)wK5PUAhXcLour6bG8xuQ2+*4Xr(#jy`CpwzXM00F0LWY=NrvZrDwXsT?#H3|l9(KSDv84e zK)NrT1|5U5kyazK_@leWPm_8e6Y@cz0Sp#_{_y~KO-&6=zz6t&!4hnB7oh#XFnCy^ z@SmSBO-*>N{{_S2U@`CuriJ_6PD=|GGr!njF|Z!}71Q}0)6o8%3l0w}o&V~qfz$d4 zV>3w Date: Sat, 10 May 2025 15:48:39 +0200 Subject: [PATCH 2/7] remove dependance on SpatialData::getZarrArrayPath --- NAMESPACE | 2 +- R/plotImage.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 6013798..5f74ea7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,13 +9,13 @@ exportMethods(rotate) exportMethods(scale) exportMethods(translation) import(SpatialData) +importFrom(DelayedArray,path) importFrom(DelayedArray,realize) importFrom(Rarr,zarr_overview) importFrom(S4Vectors,metadata) importFrom(SingleCellExperiment,int_colData) importFrom(SingleCellExperiment,int_metadata) importFrom(SpatialData,channels) -importFrom(SpatialData,getZarrArrayPath) importFrom(dplyr,mutate) importFrom(dplyr,select) importFrom(ggforce,geom_circle) diff --git a/R/plotImage.R b/R/plotImage.R index b78608f..2cf6098 100644 --- a/R/plotImage.R +++ b/R/plotImage.R @@ -103,11 +103,11 @@ plotSpatialData <- \() ggplot() + scale_y_reverse() + .theme } # check if an image is rgb or not -#' @importFrom SpatialData getZarrArrayPath +#' @importFrom DelayedArray path #' @importFrom Rarr zarr_overview #' @noRd .get_img_dt <- \(a) { - pa <- getZarrArrayPath(a) + pa <- DelayedArray::path(a) df <- zarr_overview(pa, as_data_frame=TRUE) if (!is.null(dt <- df$data_type)) return(dt) } From 8cf609e56aebbcfe582d2ada604153f0b85d91eb Mon Sep 17 00:00:00 2001 From: Artur-man Date: Sat, 10 May 2025 16:26:48 +0200 Subject: [PATCH 3/7] add k argument for plotLabel, selecting custom scales from multiscales --- R/plotLabel.R | 7 +++++-- man/plotLabel.Rd | 5 +++++ tests/testthat/Rplots.pdf | Bin 4050 -> 0 bytes tests/testthat/test-plotArray.R | 3 +-- vignettes/SpatialData.plot.Rmd | 8 ++++---- 5 files changed, 15 insertions(+), 8 deletions(-) delete mode 100644 tests/testthat/Rplots.pdf diff --git a/R/plotLabel.R b/R/plotLabel.R index 756cc52..93b6325 100644 --- a/R/plotLabel.R +++ b/R/plotLabel.R @@ -3,6 +3,9 @@ #' #' @param x \code{SpatialData} object. #' @param i character string or index; the label element to plot. +#' @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}. @@ -47,11 +50,11 @@ NULL #' scale_fill_manual scale_fill_gradientn #' aes geom_raster theme unit guides guide_legend #' @export -setMethod("plotLabel", "SpatialData", \(x, i=1, c=NULL, +setMethod("plotLabel", "SpatialData", \(x, i=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 <- as.matrix(.get_multiscale_data(label(x, i))) + y <- as.matrix(.get_multiscale_data(label(x, i), k)) df <- data.frame(x=c(col(y)), y=c(row(y)), z=c(y)) aes <- aes(.data[["x"]], .data[["y"]]) if (!is.null(c)) { diff --git a/man/plotLabel.Rd b/man/plotLabel.Rd index cb5c012..eb57cc3 100644 --- a/man/plotLabel.Rd +++ b/man/plotLabel.Rd @@ -8,6 +8,7 @@ \S4method{plotLabel}{SpatialData}( x, i = 1, + k = NULL, c = NULL, a = 0.5, pal = c("red", "green"), @@ -20,6 +21,10 @@ \item{i}{character string or index; the label element to plot.} +\item{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.} + \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}.} diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf deleted file mode 100644 index 90b57b60f68501de9f476aa6a4e9e4b6e9d11584..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 4050 zcmbtXc|25Y-xnd%B3qg}J*=tuuV=<6du6DCArQ|L4Ti46fLf-V+~)kJHeb&WhAr-{FeF%u= z&1ZrA!3F>wf*240nvmEeD%}?VZArcm3($ZKh`_%cw0?8o+wrZL5RLt}IcP$svEd~P z&|Y;1i4cp5{Q}{%GZ~uKZogbmUpY4C8ib4NhTvsjre`MFfWaUDI zTz(_Vuk*h`|4fzzfL0W57T^Z(>rMptMQB|6OH44 z9zR_ezu@0F!+k-vhuDA{2zMr&2MT0+AV4$tvH*R3xV)fgAluxY&F@BieSQo$50%ce zXOPIN2*@Iu8v~lFB;Z~6{kznBh@Zp_JYZsCOkzRa0G@B<@!f#G`hGkk{?*d>Nk9U0 zfV?{S9ow$uaO#mJ#MLDTJ* zhvXMRk7d{KUiwaR`)UNvu0#pnKjg~5GUF|a zW`gO0Aii>oRKk}BM-ZO0- zZM46de?6)<%wy&9xrGy{p3z}bNP_%ggzUrzr;3Y<;RKF7wG zcxusnf(r-_T02Ggnf;5}m2eg82%67>4c;K<$wL#7=te?VRSWZ#EbD+@8>to|d`Hi~P!U zsyg_!b&FD164{)9t&+6sczLR=8*UpDlDfC{_C1Lz0r6oWK_gV$+T&iB z;YjJTYY2d>ba+M1*7K3YUc0Y}aB?JYQFz8yb_97Cr!A@;(dM;wU=0zyDJxuM2JzT% zbM&d!%`(JTHek{!ck7h%*==uxgiR!D<<75DHZisklrfyhAzqU!iW$%K8FL#$vHz$M z*l1FjW9KKiBoi#U6D?NI;CfSnDqQAeqrEOETDIZg3|3oSJ+kuN1%^<_=Ba3##*4!e z&WQaHg%aVLC3LSOpe454H#1HSR1%X=xN%nUsvyPi`Pm&;<*VZ@k_%hiq(w|kF}4TK zuYV*jb86&DYOZ50KCj45)Hd_lzTU&Vs6P>(B&^MjU1{&?7!zQt>LN1})Xki7E_ZGp zD;txT(_WGhiOMA>Vv@Fo9hBQ8Qzlr3EZf$Tq;m?{oJcAtb^eELpWHiQzAytLEBRRNvI#Il7cBbtEv}hJ0 z9=dLSQnmt0DpBm8(H6#gNNTy~I?c4Ls;mNylq5gJ9eTjH5?&SKd_bR|ZzHE%uWV=G zql8z9P*U($nB1MI_)@VBNO@@HEzZ<;IXGxc+m)>_wEM1I&K~DIYf&@Oj(dAi>^<&w zfdz3+IEOh0_kX07IOhfuj$3@VF6sHu;&kx?JJ)=NJhsETnC^1y;eIn62OX23GG@X@ z;lIqKRh!~QOkUZ=qn1&=D6&Izkqu;D-OK4U8+RGk-e{sxAlyl$cUbMP&Efj-T~F{&_7;^qd3!DB+J`5Wz0aSR z^$uRw=;ikI^j2OExIWZlNJ*naAA9rX`!4MpAK07xliK8_GS2D5jt=xiYqsNd;+*`Z zdgMAY`nvl*_B`q?>ekKsdPd&H7`;_~TkGKHXl-c4_h>thL5V|KR=&_%bak z%ni&oY;61X$HH%G+hf%_w;bAHoFJ00?Vw~&N_ry|N^m)27Gf*jD3^{4#N zyAAbEzeYvnMYZO(le)X^VY*8DK8PeVBgp15QhkT_R7%RHqey70Ph(Wnv6 z*R#)4v1C)pQ>yR0<-7|0!3$pPgOi=HBT|3aPqK!bcv}6HPXZqC2I;4URKm)`&VIvx z+qTAa%|Q6u@au*x_bxkqBBevv(|Vz8^uK zS$x^mwv3CD?s#Q{q$Xt2pKzZ)K! zwYraoO|oOxr7NYMLMPl3Wa3SmwD48bYcJxSqn>G3QKkxttmUl&m1V7pt@c_D(cjYQ z7caCsT{yyhey$w4`8b!#bA0Uhs&C@OK;?FnlR6KSf3f3M9ZQsK{xIpH-o^KKY)MXb zl?gYkZdth^-TOTt+lq>DF30kd#Th5-lf^!h1<#+>2Gy3l|M0BGvGA~y>jJIBYq~x7 z?ox+HUQ9eUjjOY~18=4^AJ)E9Q+*)sdilG?&{v`FBI1O&?MdzJYM0cYV#bZDoR41j z8`_2f!+KseQ*Y18Qx?8*PQnN-g8UG(r5t;oA7HSRvB^W;Le z@?_G)j(vXwmRGjq7rs8(HoYLp*gQbm*sUuwu|V+ z%Ei`zdLC2AEUl1{_~i>dPIV<&wObgI-K{IhuO{rC(g!W76zU$lo2>4-_~lCr+d^?)Noe)@s3>>Yglc<|66TZfRsk{bm{co{b`|NpSR9^m?})P$qp4-h@M^kZOX>{ ztiJxGcT8!pxS-Hr!NZ?h|Gjde(2Qs-%69+(5-2`C5G-=|D#i`KX@dR~8ixhw;KAb@ zIvb)wK5PUAhXcLour6bG8xuQ2+*4Xr(#jy`CpwzXM00F0LWY=NrvZrDwXsT?#H3|l9(KSDv84e zK)NrT1|5U5kyazK_@leWPm_8e6Y@cz0Sp#_{_y~KO-&6=zz6t&!4hnB7oh#XFnCy^ z@SmSBO-*>N{{_S2U@`CuriJ_6PD=|GGr!njF|Z!}71Q}0)6o8%3l0w}o&V~qfz$d4 zV>3w Date: Sat, 10 May 2025 17:29:12 +0200 Subject: [PATCH 4/7] implement transformations for labels before plotting --- R/plotLabel.R | 13 ++++++++++--- man/plotLabel.Rd | 3 +++ tests/testthat/test-plotArray.R | 3 +++ vignettes/SpatialData.plot.Rmd | 10 +++++----- 4 files changed, 21 insertions(+), 8 deletions(-) diff --git a/R/plotLabel.R b/R/plotLabel.R index 93b6325..d4a00af 100644 --- a/R/plotLabel.R +++ b/R/plotLabel.R @@ -3,6 +3,7 @@ #' #' @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. @@ -50,12 +51,18 @@ NULL #' scale_fill_manual scale_fill_gradientn #' aes geom_raster theme unit guides guide_legend #' @export -setMethod("plotLabel", "SpatialData", \(x, i=1, k=NULL, c=NULL, +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 <- as.matrix(.get_multiscale_data(label(x, i), k)) - df <- data.frame(x=c(col(y)), y=c(row(y)), z=c(y)) + 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) aes <- aes(.data[["x"]], .data[["y"]]) if (!is.null(c)) { stopifnot(length(c) == 1, is.character(c)) diff --git a/man/plotLabel.Rd b/man/plotLabel.Rd index eb57cc3..c1618ec 100644 --- a/man/plotLabel.Rd +++ b/man/plotLabel.Rd @@ -8,6 +8,7 @@ \S4method{plotLabel}{SpatialData}( x, i = 1, + j = 1, k = NULL, c = NULL, a = 0.5, @@ -21,6 +22,8 @@ \item{i}{character string or index; the label element to plot.} +\item{j}{name of target coordinate system.} + \item{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.} diff --git a/tests/testthat/test-plotArray.R b/tests/testthat/test-plotArray.R index 9972074..95ce0af 100644 --- a/tests/testthat/test-plotArray.R +++ b/tests/testthat/test-plotArray.R @@ -61,6 +61,9 @@ test_that("plotLabel()", { expect_s3_class(q, "ggplot") expect_equal(q$coordinates$ratio, 1) expect_is(q$layers[[1]]$mapping$fill, "quosure") + # multiscale + y <- label(x, "blobs_multiscale_labels") + y <- y[,seq_len(32)] # same thing but different # alpha q <- p + plotLabel(x, i, a=a <- runif(1)) expect_identical(q$layers[[1]]$aes_params$alpha, a) diff --git a/vignettes/SpatialData.plot.Rmd b/vignettes/SpatialData.plot.Rmd index 7ef5c14..bad7921 100644 --- a/vignettes/SpatialData.plot.Rmd +++ b/vignettes/SpatialData.plot.Rmd @@ -168,7 +168,7 @@ Such labels could be morphological regions annotated by pathologists. ```{r merfish-read} dir.create(td <- tempfile()) -pa <- unzip_spd_demo( +pa <- SpatialData.data:::.unzip_spd_demo( zipname="merfish.zarr.zip", dest=td, source="biocOSN") (x <- readSpatialData(pa, anndataR=FALSE)) @@ -207,7 +207,7 @@ Mouse intestine, 1GB; 4 image resolutions and 3 shapes at 2, 8, and 16 $\mu$m. ```{r visiumhd-read} dir.create(td <- tempfile()) -pa <- unzip_spd_demo( +pa <- SpatialData.data:::.unzip_spd_demo( zipname="visium_hd_3.0.0_io.zip", dest=td, source="biocOSN") (x <- readSpatialData(pa, images=4, shapes=3, tables=FALSE)) @@ -226,7 +226,7 @@ Colorectal carcinoma, 25 MB; no shapes, no points. ```{r mibitof-read} dir.create(td <- tempfile()) -pa <- unzip_spd_demo( +pa <- SpatialData.data:::.unzip_spd_demo( zipname="mibitof.zip", dest=td, source="biocOSN") (x <- readSpatialData(pa, anndataR=FALSE)) @@ -246,7 +246,7 @@ Small lung adenocarcinoma, 250 MB; 1 image, 2 labels, 2 tables. ```{r mcmicro-read} dir.create(td <- tempfile()) -pa <- unzip_spd_demo( +pa <- SpatialData.data:::.unzip_spd_demo( zipname="mcmicro_io.zip", dest=td, source="biocOSN") (x <- readSpatialData(pa, anndataR=FALSE)) @@ -273,7 +273,7 @@ plotSpatialData() + plotImage(x, ```{r steinbock-read} dir.create(td <- tempfile()) -pa <- unzip_spd_demo( +pa <- SpatialData.data:::.unzip_spd_demo( zipname="steinbock_io.zip", dest=td, source="biocOSN") x <- readSpatialData(pa, anndataR=FALSE) From fb24054c1aa7227bc9636dfb1b21c444e3e12f31 Mon Sep 17 00:00:00 2001 From: Artur-man Date: Fri, 23 May 2025 14:46:54 +0200 Subject: [PATCH 5/7] get value from valTable instead of int_colData at plotLabel --- R/AllGenerics.R | 7 - R/plotLabel.R | 4 +- vignettes/SpatialData.plot.html | 1273 ------------------------------- 3 files changed, 3 insertions(+), 1281 deletions(-) delete mode 100644 vignettes/SpatialData.plot.html diff --git a/R/AllGenerics.R b/R/AllGenerics.R index fda170e..96c05ae 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -5,13 +5,6 @@ setGeneric("rotate", \(x, t, ...) standardGeneric("rotate")) setGeneric("transform", \(x, ...) standardGeneric("transform")) setGeneric("translation", \(x, t, ...) standardGeneric("translation")) -# tbl ---- - -setGeneric("hasTable", \(x, i, ...) standardGeneric("hasTable")) -setGeneric("getTable", \(x, i, ...) standardGeneric("getTable")) -setGeneric("setTable", \(x, i, ...) standardGeneric("setTable")) -setGeneric("valTable", \(x, i, ...) standardGeneric("valTable")) - # plt ---- setGeneric("plotImage", \(x, ...) standardGeneric("plotImage")) diff --git a/R/plotLabel.R b/R/plotLabel.R index cf4cf1b..e61f979 100644 --- a/R/plotLabel.R +++ b/R/plotLabel.R @@ -70,7 +70,9 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, stopifnot(length(c) == 1, is.character(c)) t <- table(x, hasTable(x, i, name=TRUE)) ik <- .instance_key(t) - idx <- match(df$z, int_colData(t)[[ik]]) + # idx <- match(df$z, int_colData(t)[[ik]]) + idx <- match(df$z, + valTable(x, i, ik, assay=assay)) df$z <- valTable(x, i, c, assay=assay)[idx] if (c == ik) df$z <- factor(df$z) aes$fill <- aes(.data[["z"]])[[1]] diff --git a/vignettes/SpatialData.plot.html b/vignettes/SpatialData.plot.html deleted file mode 100644 index 4ba2178..0000000 --- a/vignettes/SpatialData.plot.html +++ /dev/null @@ -1,1273 +0,0 @@ - - - - - - - - - - - - - - -SpatialData.plot - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - - - - -

Contents

- - -
library(ggplot2)
-library(patchwork)
-library(ggnewscale)
-library(SpatialData)
-library(SpatialData.data)
-library(SpatialData.plot)
-library(SingleCellExperiment)
-
-

1 Introduction

-

The SpatialData package contains a set of reader and plotting functions for -spatial omics data stored as SpatialData -.zarr files that follow OME-NGFF specs.

-

Each SpatialData object is composed of five layers: images, labels, shapes, -points, and tables. Each layer may contain an arbitrary number of elements.

-

Images and labels are represented as ZarrArrays (Rarr). -Points and shapes are represented as arrow objects linked -to an on-disk .parquet file. As such, all data are represented out of memory.

-

Element annotation as well as cross-layer summarizations (e.g., count matrices) -are represented as SingleCellExperiment as tables.

-
x <- file.path("extdata", "blobs.zarr")
-x <- system.file(x, package="SpatialData")
-(x <- readSpatialData(x, anndataR=FALSE))
-
## class: SpatialData
-## - images(2):
-##   - blobs_image (3,64,64)
-##   - blobs_multiscale_image (3,64,64)
-## - labels(2):
-##   - blobs_labels (64,64)
-##   - blobs_multiscale_labels (64,64)
-## - points(1):
-##   - blobs_points (200)
-## - shapes(3):
-##   - blobs_circles (5,circle)
-##   - blobs_multipolygons (2,polygon)
-##   - blobs_polygons (5,polygon)
-## - tables(1):
-##   - table (3,10)
-## coordinate systems:
-## - global(8): blobs_image blobs_multiscale_image ... blobs_polygons
-##   blobs_points
-## - scale(1): blobs_labels
-## - translation(1): blobs_labels
-## - affine(1): blobs_labels
-## - sequence(1): blobs_labels
-
-
-

2 Visualization

-
-

2.0.1 Images

-

Image/LabelArrays are linked to potentially multiscale .zarr stores. -Their show method includes the scales available for a given element:

-
image(x, "blobs_image")
-
## class: ImageArray  
-## Scales (1): (3,64,64)
-
image(x, "blobs_multiscale_image")
-
## class: ImageArray (MultiScale) 
-## Scales (3): (3,64,64) (3,32,32) (3,16,16)
-

Internally, multiscale ImageArrays are stored as a list of ZarrArray, e.g.:

-
i <- image(x, "blobs_multiscale_image")
-vapply(i@data, dim, numeric(3))
-
##      [,1] [,2] [,3]
-## [1,]    3    3    3
-## [2,]   64   32   16
-## [3,]   64   32   16
-

To retrieve a specific scale’s ZarrArray, we can use data(., k), -where k specifies the target scale. This also works for plotting:

-
wrap_plots(nrow=1, lapply(seq(3), \(.) 
-    plotSpatialData() + plotImage(x, i=2, k=.)))
-

-
-
-

2.0.2 Labels

-
i <- "blobs_labels"
-t <- getTable(x, i)
-t$id <- sample(letters, ncol(t))
-table(x) <- t
-
-p <- plotSpatialData()
-pal_d <- hcl.colors(10, "Spectral")
-pal_c <- hcl.colors(9, "Inferno")[-9]
-
-a <- p + plotLabel(x, i) # simple binary image
-b <- p + plotLabel(x, i, "id", pal=pal_d) # 'colData'
-c <- p + plotLabel(x, i, "channel_1_sum", pal=pal_c) + 
-    theme(legend.key.width=unit(1, "lines")) # 'assay'
-
-(a | b | c) + 
-    plot_layout(guides="collect") & 
-    theme(legend.position="bottom")
-

-
-
-

2.0.3 Points

-
i <- "blobs_points"
-p <- plotSpatialData()
-# mock up a 'table'
-f <- list(
-  numbers=\(n) runif(n),
-  letters=\(n) sample(letters, n, TRUE))
-y <- setTable(x, i, f)
-# demo. viz. capabilities
-a <- p + plotPoint(y, i) # simple dots
-b <- p + plotPoint(y, i, "letters") # discrete coloring
-c <- p + plotPoint(y, i, "numbers") # continuous coloring
-a | b | c
-

-
-
-

2.0.4 Shapes

-
p <- plotSpatialData()
-a <- p +
-  ggtitle("polygons") +
-  plotShape(x, "blobs_polygons")
-b <- p +
-  ggtitle("multipolygons") +
-  plotShape(x, "blobs_multipolygons")
-c <- p +
-  ggtitle("circles") +
-  plotShape(x, "blobs_circles")
-wrap_plots(a, b, c)
-

-
-
-

2.0.5 Layering

-
p <- plotSpatialData()
-# joint
-all <- p +
-    plotImage(x) +
-    plotLabel(x, a=1/3) +
-    plotShape(x, 1) +
-    plotShape(x, 3) +
-    new_scale_color() +
-    plotPoint(x, c="genes") +
-    ggtitle("layered")
-# split
-one <- list(
-    p + plotImage(x) + ggtitle("image"),
-    p + plotLabel(x) + ggtitle("labels"),
-    p + plotShape(x, 1) + ggtitle("circles"),
-    p + plotShape(x, 3) + ggtitle("polygons"),
-    p + plotPoint(x, c="genes") + ggtitle("points"))
-wrap_plots(c(list(all), one), nrow=2)
-

-
-
-
-

3 Examples

-
-

3.1 MERFISH

-

In this example data, we do not have a label for the shape polygons. -Such labels could be morphological regions annotated by pathologists.

-
dir.create(td <- tempfile())
-pa <- unzip_spd_demo(
-    zipname="merfish.zarr.zip", 
-    dest=td, source="biocOSN")
-(x <- readSpatialData(pa, anndataR=FALSE))
-
## class: SpatialData
-## - images(1):
-##   - rasterized (1,522,575)
-## - labels(0):
-## - points(1):
-##   - single_molecule (3714642)
-## - shapes(2):
-##   - anatomical (6,polygon)
-##   - cells (2389,circle)
-## - tables(1):
-##   - table (268,2389)
-## coordinate systems:
-## - global(4): rasterized anatomical cells single_molecule
-

There are only 2389 cells, but -3,714,642 -molecules, so that we downsample a random subset of 1,000 for visualization:

-
# downsample 1,000 points
-n <- length(p <- point(x))
-q <- p[sample(n, 1e3)]
-(point(x, "1k") <- q)
-
## class: PointFrame
-## count: 1000 
-## data(3): x y cell_type
-
# layered visualization
-plotSpatialData() +
-    plotImage(x) +
-    new_scale_color() +
-    plotPoint(x, i="1k", c="cell_type", s=0.2) +
-    new_scale_color() +
-    plotShape(x, i="anatomical") +
-    scale_color_manual(values=hcl.colors(6, "Spectral"))
-

-
# bounding-box query
-qu <- list(xmin=1800, xmax=2400, ymin=5000, ymax=5400)
-bb <- geom_rect(do.call(aes, qu), data.frame(qu), col="yellow", fill=NA)
-y <- SpatialData(images=list("."=do.call(query, c(list(x=image(x)), qu))))
-plotSpatialData() + plotImage(x) + bb | plotSpatialData() + plotImage(y)
-

-
-
-

3.2 VisiumHD

-

Mouse intestine, 1GB; 4 image resolutions and 3 shapes at 2, 8, and 16 \(\mu\)m.

-
dir.create(td <- tempfile())
-pa <- unzip_spd_demo(
-    zipname="visium_hd_3.0.0_io.zip", 
-    dest=td, source="biocOSN")
-(x <- readSpatialData(pa, images=4, shapes=3, tables=FALSE))
-
## class: SpatialData
-## - images(1):
-##   - Visium_HD_Mouse_Small_Intestine_lowres_image (3,558,600)
-## - labels(0):
-## - points(0):
-## - shapes(1):
-##   - Visium_HD_Mouse_Small_Intestine_square_016um (91033,circle)
-## - tables(3):
-##   - square_002um (19059,5479660)
-##   - square_008um (19059,351817)
-##   - square_016um (19059,91033)
-## coordinate systems:
-## - downscaled_lowres(2): Visium_HD_Mouse_Small_Intestine_lowres_image
-##   Visium_HD_Mouse_Small_Intestine_square_016um
-## - global(1): Visium_HD_Mouse_Small_Intestine_square_016um
-## - downscaled_hires(1): Visium_HD_Mouse_Small_Intestine_square_016um
-
qu <- list(xmin=100, xmax=300, ymin=200, ymax=400)
-bb <- geom_rect(do.call(aes, qu), data.frame(qu), col="black", fill=NA)
-y <- SpatialData(images=list("."=do.call(query, c(list(x=image(x)), qu))))
-plotSpatialData() + plotImage(x) + bb | plotSpatialData() + plotImage(y)
-

-
-
-

3.3 MibiTOF

-

Colorectal carcinoma, 25 MB; no shapes, no points.

-
dir.create(td <- tempfile())
-pa <- unzip_spd_demo(
-    zipname="mibitof.zip", 
-    dest=td, source="biocOSN")
-(x <- readSpatialData(pa, anndataR=FALSE))
-
## class: SpatialData
-## - images(3):
-##   - point16_image (3,1024,1024)
-##   - point23_image (3,1024,1024)
-##   - point8_image (3,1024,1024)
-## - labels(3):
-##   - point16_labels (1024,1024)
-##   - point23_labels (1024,1024)
-##   - point8_labels (1024,1024)
-## - points(0):
-## - shapes(0):
-## - tables(1):
-##   - table (36,3309)
-## coordinate systems:
-## - point16(2): point16_image point16_labels
-## - point23(2): point23_image point23_labels
-## - point8(2): point8_image point8_labels
-
pal <- hcl.colors(8, "Spectral")
-wrap_plots(nrow=1, lapply(seq(3), \(.)
-    plotSpatialData() + plotImage(x, .) + 
-    plotLabel(x, ., "Cluster", pal=pal))) +
-    plot_layout(guides="collect")
-

-
-
-

3.4 CyCIF (MCMICRO)

-

Small lung adenocarcinoma, 250 MB; 1 image, 2 labels, 2 tables.

-
dir.create(td <- tempfile())
-pa <- unzip_spd_demo(
-    zipname="mcmicro_io.zip", 
-    dest=td, source="biocOSN")
-(x <- readSpatialData(pa, anndataR=FALSE))
-
## class: SpatialData
-## - images(1):
-##   - exemplar-001_image (12,3139,2511)
-## - labels(2):
-##   - exemplar-001_cell (3139,2511)
-##   - exemplar-001_nuclei (3139,2511)
-## - points(0):
-## - shapes(0):
-## - tables(2):
-##   - exemplar-001--ilastik_cell (12,11607)
-##   - exemplar-001--unmicst_cell (12,11170)
-## coordinate systems:
-## - global(3): exemplar-001_image exemplar-001_cell exemplar-001_nuclei
-

Getting channel names for the image:

-
channels(image(x))
-
##  [1] "DNA_6" "ELANE" "CD57"  "CD45"  "DNA_7" "CD11B" "SMA"   "CD16"  "DNA_8"
-## [10] "ECAD"  "FOXP3" "NCAM"
-

Plotting with multiple image channels:

-
plotSpatialData() + plotImage(x,
-    ch=c("DNA_6", "CD45", "CD57"), 
-    c=c("blue", "cyan", "yellow"),
-    cl=list(NULL, c(0, 0.1), NULL))
-

-
-
-

3.5 IMC (Steinbock)

-

4 different cancers (SCCHN, BCC, NSCLC, CRC), 820 MB; 14 images, 14 labels, 1 table.

-
dir.create(td <- tempfile())
-pa <- unzip_spd_demo(
-    zipname="steinbock_io.zip", 
-    dest=td, source="biocOSN")
-x <- readSpatialData(pa, anndataR=FALSE)
-
-

3.5.1 channels

-
plotSpatialData() + plotImage(x,
-    i="Patient3_003_image",
-    ch=c(6, 22, 39),
-    c=c("blue", "cyan", "yellow"))
-

-
-
-

3.5.2 contrasts

-
i <- image(x, "Patient3_003_image")
-image(x, "crop") <- i[, 200:400, 200:400]
-lapply(list(c(0.2, 1), c(0, 0.8), c(0, 1.2)), \(.) {
-    plotSpatialData() + plotImage(x, 
-        i="crop", 
-        ch=c(6, 22, 39), 
-        cl=list(1, 1, .),
-        c=c("blue", "cyan", "yellow")) +
-        ggtitle(sprintf("[%s, %s]", .[1], .[2]))
-}) |> wrap_plots(nrow=1) + plot_layout(guides="collect")
-

-
-
-
-
-

4 Masking

-

Back to blobs…

-
x <- file.path("extdata", "blobs.zarr")
-x <- system.file(x, package="SpatialData")
-x <- readSpatialData(x, tables=FALSE)
-
i <- "blobs_circles"
-x <- mask(x, "blobs_points", i)
-(t <- getTable(x, i))
-
## class: SingleCellExperiment 
-## dim: 2 5 
-## metadata(0):
-## assays(1): counts
-## rownames(2): gene_a gene_b
-## rowData names(0):
-## colnames(5): 1 2 3 4 5
-## colData names(0):
-## reducedDimNames(0):
-## mainExpName: NULL
-## altExpNames(0):
-
p <- plotSpatialData() + 
-    plotPoint(x, c="genes") +
-    scale_color_manual(values=c("tomato", "cornflowerblue")) +
-    new_scale_color()
-lapply(names(c <- c(a="red", b="blue")), \(.)
-    p + plotShape(x, i, c=paste0("gene_", .)) + 
-        scale_color_gradient2(
-            low="grey", high=c[.],
-            limits=c(0, 8), n.breaks=5)) |>
-    wrap_plots() + plot_layout(guides="collect")
-

-
# compute channel-wise means
-i <- "blobs_labels"
-table(x) <- NULL
-x <- mask(x, "blobs_image", i, fun=mean)
-(t <- getTable(x, i))
-
## class: SingleCellExperiment 
-## dim: 3 10 
-## metadata(0):
-## assays(1): counts
-## rownames(3): 1 2 3
-## rowData names(0):
-## colnames(10): 12 11 ... 16 4
-## colData names(0):
-## reducedDimNames(0):
-## mainExpName: NULL
-## altExpNames(0):
-
# visualize side-by-side
-ps <- lapply(paste(seq_len(3)), \(.) 
-    plotSpatialData() + plotLabel(x, i, .) + 
-    ggtitle(paste("channel", ., "sum"))) 
-wrap_plots(ps, nrow=1) & theme(
-    legend.position="bottom", 
-    legend.title=element_blank(),
-    legend.key.width=unit(1, "lines"),
-    legend.key.height=unit(0.5, "lines"))
-

-
-
-

5 Session info

-
## R version 4.4.1 Patched (2024-07-08 r86893)
-## Platform: aarch64-apple-darwin20
-## Running under: macOS Sonoma 14.2.1
-## 
-## Matrix products: default
-## BLAS:   /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRblas.0.dylib 
-## LAPACK: /Library/Frameworks/R.framework/Versions/4.4-arm64/Resources/lib/libRlapack.dylib;  LAPACK version 3.12.0
-## 
-## locale:
-## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
-## 
-## time zone: Europe/Madrid
-## tzcode source: internal
-## 
-## attached base packages:
-## [1] stats4    stats     graphics  grDevices utils     datasets  methods  
-## [8] base     
-## 
-## other attached packages:
-##  [1] SingleCellExperiment_1.28.1 SummarizedExperiment_1.36.0
-##  [3] Biobase_2.66.0              GenomicRanges_1.58.0       
-##  [5] GenomeInfoDb_1.42.1         IRanges_2.40.1             
-##  [7] S4Vectors_0.44.0            BiocGenerics_0.52.0        
-##  [9] MatrixGenerics_1.18.0       matrixStats_1.5.0          
-## [11] SpatialData.plot_0.99.2     SpatialData.data_0.99.2    
-## [13] SpatialData_0.99.23         ggnewscale_0.5.0           
-## [15] patchwork_1.3.0             ggplot2_3.5.1              
-## [17] BiocStyle_2.34.0           
-## 
-## loaded via a namespace (and not attached):
-##  [1] DBI_1.2.3               RBGL_1.82.0             rlang_1.1.4            
-##  [4] magrittr_2.0.3          Rarr_1.6.0              e1071_1.7-16           
-##  [7] compiler_4.4.1          RSQLite_2.3.9           dir.expiry_1.14.0      
-## [10] paws.storage_0.7.0      png_0.1-8               vctrs_0.6.5            
-## [13] stringr_1.5.1           pkgconfig_2.0.3         wk_0.9.4               
-## [16] crayon_1.5.3            fastmap_1.2.0           magick_2.8.5           
-## [19] dbplyr_2.5.0            XVector_0.46.0          labeling_0.4.3         
-## [22] paws.common_0.7.7       rmarkdown_2.29          graph_1.84.0           
-## [25] UCSC.utils_1.2.0        tinytex_0.54            purrr_1.0.2            
-## [28] bit_4.5.0.1             xfun_0.50               zlibbioc_1.52.0        
-## [31] cachem_1.1.0            jsonlite_1.8.9          blob_1.2.4             
-## [34] DelayedArray_0.32.0     tweenr_2.0.3            parallel_4.4.1         
-## [37] R6_2.5.1                bslib_0.8.0             stringi_1.8.4          
-## [40] reticulate_1.40.0       jquerylib_0.1.4         Rcpp_1.0.13-1          
-## [43] bookdown_0.42           assertthat_0.2.1        knitr_1.49             
-## [46] R.utils_2.12.3          Matrix_1.7-1            tidyselect_1.2.1       
-## [49] rstudioapi_0.17.1       abind_1.4-8             yaml_2.3.10            
-## [52] zellkonverter_1.16.0    curl_6.1.0              lattice_0.22-6         
-## [55] tibble_3.2.1            basilisk.utils_1.18.0   withr_3.0.2            
-## [58] evaluate_1.0.1          sf_1.0-19               polyclip_1.10-7        
-## [61] units_0.8-5             proxy_0.4-27            BiocFileCache_2.14.0   
-## [64] pillar_1.10.1           BiocManager_1.30.25     filelock_1.0.3         
-## [67] KernSmooth_2.23-26      generics_0.1.3          nanoarrow_0.6.0        
-## [70] munsell_0.5.1           scales_1.3.0            class_7.3-23           
-## [73] glue_1.8.0              tools_4.4.1             grid_4.4.1             
-## [76] colorspace_2.1-1        GenomeInfoDbData_1.2.13 basilisk_1.18.0        
-## [79] ggforce_0.4.2           cli_3.6.3               S4Arrays_1.6.0         
-## [82] arrow_18.1.0            dplyr_1.1.4             geoarrow_0.2.1         
-## [85] gtable_0.3.6            R.methodsS3_1.8.2       sass_0.4.9             
-## [88] digest_0.6.37           classInt_0.4-10         SparseArray_1.6.0      
-## [91] farver_2.1.2            memoise_2.0.1           htmltools_0.5.8.1      
-## [94] R.oo_1.27.0             lifecycle_1.0.4         httr_1.4.7             
-## [97] MASS_7.3-64             bit64_4.5.2
-
- - - - -
- - - - - - - - - - - - - - - - - - From 815575b363c3cb1038b44757a4e02a9b46aa89fb Mon Sep 17 00:00:00 2001 From: Artur-man Date: Fri, 23 May 2025 23:40:28 +0200 Subject: [PATCH 6/7] fix plotLabel bug for j in colData --- R/plotLabel.R | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/R/plotLabel.R b/R/plotLabel.R index e61f979..d920d48 100644 --- a/R/plotLabel.R +++ b/R/plotLabel.R @@ -70,9 +70,15 @@ setMethod("plotLabel", "SpatialData", \(x, i=1, j=1, k=NULL, c=NULL, stopifnot(length(c) == 1, is.character(c)) t <- table(x, hasTable(x, i, name=TRUE)) ik <- .instance_key(t) + # TODO: search ik in both internal and regular colData for now + # thus perhaps update, SpatialData::valTable instead # idx <- match(df$z, int_colData(t)[[ik]]) - idx <- match(df$z, - valTable(x, i, ik, assay=assay)) + if(ik %in% names(int_colData(t))){ + coldata <- int_colData(t)[[ik]] + } else { + coldata <- colData(t)[[ik]] + } + idx <- match(df$z, coldata) df$z <- valTable(x, i, c, assay=assay)[idx] if (c == ik) df$z <- factor(df$z) aes$fill <- aes(.data[["z"]])[[1]] From 1ac63627e793eb5008d166ae2aa6f54eab874bdd Mon Sep 17 00:00:00 2001 From: Artur-man Date: Sat, 24 May 2025 14:10:33 +0200 Subject: [PATCH 7/7] fix plotLabel example --- NAMESPACE | 1 + R/plotLabel.R | 5 +++-- man/plotLabel.Rd | 4 ++-- tests/testthat/Rplots.pdf | Bin 0 -> 4271 bytes 4 files changed, 6 insertions(+), 4 deletions(-) create mode 100644 tests/testthat/Rplots.pdf diff --git a/NAMESPACE b/NAMESPACE index 5f74ea7..9d11af7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,6 +13,7 @@ importFrom(DelayedArray,path) importFrom(DelayedArray,realize) importFrom(Rarr,zarr_overview) importFrom(S4Vectors,metadata) +importFrom(SingleCellExperiment,colData) importFrom(SingleCellExperiment,int_colData) importFrom(SingleCellExperiment,int_metadata) importFrom(SpatialData,channels) diff --git a/R/plotLabel.R b/R/plotLabel.R index d920d48..f390555 100644 --- a/R/plotLabel.R +++ b/R/plotLabel.R @@ -38,10 +38,10 @@ #' # TODO: did a small fix to color scheme below, will fix example later #' # pal <- hcl.colors(n, "Spectral") #' pal_d <- hcl.colors(10, "Spectral") -#' p + plotLabel(x, i, "id", pal=pal_d) +#' p + plotLabel(x, i, c = "id", pal=pal_d) #' #' # coloring by 'assay' data -#' p + plotLabel(x, i, "channel_1_sum") +#' p + plotLabel(x, i, c = "channel_1_sum") NULL #' @rdname plotLabel @@ -52,6 +52,7 @@ NULL #' @importFrom ggplot2 #' scale_fill_manual scale_fill_gradientn #' aes geom_raster theme unit guides guide_legend +#' @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) { diff --git a/man/plotLabel.Rd b/man/plotLabel.Rd index 5c94e77..d819bb8 100644 --- a/man/plotLabel.Rd +++ b/man/plotLabel.Rd @@ -66,8 +66,8 @@ n <- length(unique(t$id)) # TODO: did a small fix to color scheme below, will fix example later # pal <- hcl.colors(n, "Spectral") pal_d <- hcl.colors(10, "Spectral") -p + plotLabel(x, i, "id", pal=pal_d) +p + plotLabel(x, i, c = "id", pal=pal_d) # coloring by 'assay' data -p + plotLabel(x, i, "channel_1_sum") +p + plotLabel(x, i, c = "channel_1_sum") } diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf new file mode 100644 index 0000000000000000000000000000000000000000..2015d488f88e0316be9890c2a303c70ec5fdaf54 GIT binary patch literal 4271 zcmbtYc|25q+ZG|yB3qhY${}hL&deBNiIN#hBn;WfG!Ew1n3-nDlCg)7H!Vt8Q?xuD z3E84#PmC?46yX<c|paI6gKM@872#~;n$Q&wzP9$?607cZtqOsa&Z7dFh!=N!ZH3VqI z@cNf)_EZiH&LRP3EHcxVN?`-mTn>}VfzxbQ3@}7bIZK=D;2E zLj;_M-?0@uITG-1I*a-7Y!Tr9t+oG>tw0t3XvEKC*#Kxs^x5TE(Zm0 z+!3HDtT4d90M-O(62LLD;|N|M0|UVxa2*-2y$*1w}w2bc9NQ1e=2UV8MUyt+pQip9)vN>AP^# zlKt)Nde+78D|ISuPOXhQ({{+0By7IA(mY9X8%AQS#l4e4%6OtZlW3civjU6i56dPb z6)49YTV`7@wj4?9I?R;aki5q$57~DoaI)oMpWb6DdEuVy+BZwS^MN*%NJ4&loB|2JgcQp-%N`zGB;X z(KINhP}m5K!9byY^QHq+9iY=gzD%=ZUF$;^O=*?fSmYKryXX_AW#V7*`Bua6bq~>N zbWUs@z&uGoIxDAuon-_4khhd~JkizDMf+*^RiU~<-4`#Onmv;25fwUtBr49; zd~gg&SuJ!k2P*EFkMX0*3Av9gv#IzL)8YvV#oemnuHhZtR37X>svS`G*?yz9*UfTS z#vwIuWO6=ZO(@|&FrQTQeDW`H!1QU|QydJzLx=7iltZj-Y#m^JT=gm=W=>K3Gk4QE zsYR8lSn!Mqu{mcius6BbwNWNkG{rdDXfETzoMg@C%RObu$DhtgwIw?VUs3wQC}fim zYMT@wanx&j+azygy_v|zmiYFR^JxqGh|fI7(!HM>*QtaiQp||hQfb@PHy0LNgmHk7 ziIK>t(S{KbnS0A`-;*j8lI#}|-i?Y~e%KS!A0c~k84-||4J*!Eew~jfT+%O~}N|3Tq zII}{PU~DcdXEc^cx~gzJdNj*>#B~J4`J-HDHK8Qa)>nF7E=YVcS|X>~<)#!(w9wO9 zcST~9e09?lR##CoqU7FLrbzJGi74xubNy0Ih+W~iQekVQ^e@GurPkdyHBJgpk&sfl zaZ>uSFxBYk$xW9P%i_$FavNP`#Y{{vHha&ke4r?IY~WIImO~ak`?{^TP1@C+UHiLG zeX`rFLrzF z{(cwcR;D9UrWAQc`o-GG1j)MTsphxPoN2IR$ckNw8A>Rb1c|>#nHz5-Yh;~jGu5>$ zwG7y;BKfQFj+&Bn*xrTWY;&^>$cc5t+0WR!{q20dQ&s@+u=(3-(jHCb z$Mb4!U9Q+?bL?M7cNAgw_n7M0>k$GAS@G{g|1y(RuZtZZytIu&Euef*6#J;_){tFU z7q`oF)Ol2QH9;#!w2ef)QpE6$EK-w;i%YX8vPic$@!+tW+QzI6?II(uXR!0+dG7p< z{TlnN_g9T>d4zwo{d)eRS62hCzI|lT_4JWx*NbafUA(T&u99p1*ZMk*sOPCshlc)q z)2@5tEoY5iVza_T>M6aL;oj~j?H1f-oTKkVr$Sq5cSrZT&IcXWJM^>P+h6?qcvjl= zO2R_ahs$gBH&~fv77~Upw^E`JHK&tWuX@d3ayZ)DPh8dV_vMl0T0!+ewn4{&#)D>O zB<9sWseIZvUpa3lrZ1)>CMuRER82Ck`gy*K?7ESO={&=vE!N zcGV$c{9zqu?+#B^i!9{<)=KNSUr^5~e4&md<_2a1Hl}6cL(x|iEioEx>-McPju(sH zuvfbCbV>~kN_6Sah}2lAQK6pUjC87V^(!1LnfLW$q|u-I@*1KK%J|y(c2cHq_oA$PRj!?YK4zZHwG zM^OB{)BKHh1nT7-(SJ45-Ba!SCiuxmdHEd63zqTC*@5-bbJKqepC}tGW4VpFU!kum zA(m9qN&fEsiAN(BL?n5V>1L-JqH?eKTp!-e_wnfVP|jbI|Cr|U!Qz7&qxKoUqV{N8 z%z(^acH`_mN4`!^$s_*<{1=R4eQKdap(nrKzie3MvaC1kRoFG7hI?njdAl!Xitc{2 zTQZ_0!lc?ziD~ZH_~B&5^y=Z2!~Vx2+QQn#vu5un)FdC{DJDutuFRJRT~C&=UE6*) ztlYCHB3U$Fxl*}Vd6Jky+;b@?TP|DX(#7lp4FL^j8q6tq2OaA@;yPnxYPk)R!R*0{ z1G)0^>b+%5gX*1Gx-aLI2TcOwHPySFQmf|Xr0Y~uRn4T^k7JH&9G}$7N)>CJ=?J@0 zY?)h1o6ww)Nf&2`GfquD0Eewr%C?-{YG`r9>P5Oi%0N0P>7D((b@nUMbLVrruT-t=9MaF=TLcGpbTo3}kVSB4+V z?{B+)SiYuJQn0hD_Rivp72A64iyIUtYv|qSX@IGYBHC`^xq)rE4 zO1t_j_9^O#ZYgyl=em`mWq_)@WuE1Bi$2CHdez+77RR#(cu!9iK{p>}(fAGz9bR^i zJ?kymh;r2AgNn~K-Ku1ZQ_PwY&+Rz(=8g^7(Y7T1rsXY57o=N{J7iN_Jj&x*yf;7L zXmvEtdpzgqU;=onJ+Kf zlYOn|bxp|2kk{d{BD|KwmKKc*8c-hd#%1n1&->NQeF34J&+BP77`Y|qHVMb5#B2(^ zI5+;jW_Qfd|GJr2#PgYR_Y*J9zAQ89_CoK`*$&n5#Ia2~{|G25X}FR*c(i$PR3^V43>zS$M{ z;{9U5%2xSA4=?vOU^7n5F&**<2xFfUcAY^wM;;xL~#T*9XFd!5@=&3$q(SaGwg?M*+i~ zqlWrZp4E{%D7^(+cR^ofLhg(xeI(aKwGyW{KQn9C!rKb&@|X))+|zwJCAV(Z_AhP= z4~KgE?*=Sl(Q-SqKfBE=cIIC^aP{t!FC7!mB4o2|!H;Ph@ztc6&|ybJrNb^wFt`4=bEMLD z)7jK-00JaZy}cpWnF*|yD}d7m{it*<8_>gphq(+6M1#CJ2n-GfdNE)#$!1dl(1%4n z0uQ-l3Rf`eQm8Bn*Uy^<1ppw2O7nstKQe{IpabAR79