44# '
55# ' @description ...
66# '
7- # ' @param x \code{\link{SpatialData}} object.
7+ # ' @param x \code{\link[spatialdataR] {SpatialData}} object.
88# ' @param i element to use from a given layer.
9- # ' @param j name of target coordinate system.
10- # ' @param k index of the scale of an image ; by default (NULL), will auto-select
9+ # ' @param j index or name of target coordinate system.
10+ # ' @param k index of the scale to render ; by default (NULL), will auto-select
1111# ' scale in order to minimize memory-usage and blurring for a target size of
1212# ' 800 x 800px; use Inf to plot the lowest resolution available.
1313# ' @param ch image channel(s) to be used for plotting (defaults to
1818# ' specifies channel-wise contrast limits - defaults to [0, 1] for all
1919# ' (ignored when \code{image(x, i)} is an RGB image;
2020# ' for convenience, any NULL = [0, 1], and n = [0, n]).
21+ # ' @param t,z integer scalar to indicate a specific time- or z-slice;
22+ # ' if left unspecified (default NULL), will perform a max-projection.
2123# '
2224# ' @return ggplot
2325# '
8486 n <- length(c )
8587 if (n < d ) stop(
8688 " Only " n , " default colors available, "
87- " but" d , " are needed; please specify 'c'"
89+ " but " d , " are needed; please specify 'c'"
8890 c <- c [seq_len(d )]
8991 }
9092 }
117119 if (dt %in% names(.DTYPE_MAX_VALUES )) {
118120 a <- a / .DTYPE_MAX_VALUES [dt ]
119121 } else if (max(a ) > 1 ) {
120- for ( i in seq_len( d ) )
121- a [ i ,,] <- a [ i ,,] / max( a [ i ,,] )
122+ maxs <- apply( a , 1 , max )
123+ a <- sweep( a , MARGIN = 1 , STATS = maxs , FUN = " / "
122124 }
123125 return (a )
124126}
@@ -159,59 +161,75 @@ NULL
159161# ' @importFrom methods as
160162# ' @importFrom DelayedArray realize
161163# ' @importFrom spatialdataR data_type
162- .df_i <- \(x , k = NULL , ch = NULL , c = NULL , cl = NULL ) {
163- a <- .get_multiscale_data(x , k )
164- a <- a [.ch_idx(x , ch ),,,drop = FALSE ]
164+ .df_i <- \(x , k = NULL , ch = NULL , t = NULL , c = NULL , cl = NULL , z = NULL ) {
165+ a <- .get_ms_data(x , k )
166+ axisNames <- axes(x , " name"
167+ # 2D max-projection
168+ a <- .project(x , a )
169+ axisNames <- axisNames [axisNames != " z"
170+ ti <- which(axisNames == " t"
171+ tn <- length(ti )
172+ # subset channels and timepoint of interest
173+ if (tn ) {
174+ if (is.null(t )) {
175+ t <- 1
176+ } else if (length(t ) > 1 ) {
177+ stop(" Only a single timepoint can be selected"
178+ }
179+ }
180+ a <- .subset_array_by_axes(a = a , axisNames = axisNames ,
181+ c = .ch_idx(x , ch ), t = t , drop = FALSE )
182+ # remove time axis if it exists
183+ if (tn ) {
184+ dim(a ) <- dim(a )[axisNames != " t"
185+ axisNames <- axisNames [- ti ]
186+ }
187+ # if no channel axis, add dummy axis
188+ if (! (" c" %in% axisNames )) {
189+ dim(a ) <- c(1 , dim(a ))
190+ axisNames <- c(" c" axisNames )
191+ }
165192 a <- .norm_ia(a , data_type(x ))
193+ # color merging & contrasts
166194 a <- .prep_ia(a , c , cl )
167195}
168196
169- # ' @importFrom spatialdataR transform
170- .get_wh <- \(x ) {
171- wh <- metadata(x )$ wh
172- if (! is.null(wh )) {
173- df <- data.frame (x = wh [[1 ]], y = wh [[2 ]])
174- } else {
175- ds <- dim(data(x , 1 ))
176- df <- data.frame (x = c(0 , ds [3 ]), y = c(0 , ds [2 ]))
177- }
178- list (w = df [, 1 ], h = df [, 2 ])
179- }
180-
197+ # ' @importFrom rlang .data
181198# ' @importFrom ggplot2 guides geom_point geom_blank annotation_raster
182199# ' @importFrom ggplot2 scale_color_identity scale_x_continuous scale_y_reverse
183200.gg_i <- \(x , w , h , pal = NULL ) {
184201 l <- if (! is.null(names(pal ))) list (
185202 guides(col = guide_legend(override.aes = list (alpha = 1 , size = 2 ))),
186203 geom_point(aes(col = .data $ foo ), data.frame (foo = pal ), x = 0 , y = 0 , alpha = 0 ))
187204 list (l ,
188- geom_blank(aes(x = x , y = y ), data.frame (x = w , y = h )),
205+ geom_blank(aes(x = .data $ x , y = .data $ y ), data.frame (x = w , y = h )),
189206 annotation_raster(x , w [1 ],w [2 ], h [2 ],h [1 ], interpolate = FALSE ),
190207 scale_color_identity(NULL , guide = " legend" breaks = pal , labels = names(pal )),
191208 ggnewscale :: new_scale_color())
192209}
193210
194211# ' @rdname plotImage
195212# ' @export
196- setMethod ("plotImage ", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, cl=NULL) {
213+ setMethod ("plotImage ", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, cl=NULL, t=NULL, z=NULL ) {
197214 if (is.numeric(i ))
198215 i <- imageNames(x )[i ]
199216 y <- image(x , i )
200217 if (is.numeric(j ))
201218 j <- CTname(y )[j ]
202219 y <- transform(y , j )
203- wh <- .get_wh(y )
204220 if (.is_rgb(y )) {
205221 # RGB: we plot everything by default and we don't normalize
206222 ch <- ch %|| % channels(y )
207223 cl <- cl %|| % c(0 , 1 / 3 )
208224 }
209- df <- .df_i(y , k , ch , c , cl )
225+ df <- .df_i(y , k , ch , t , c , cl , z )
210226 pal <- c %|| % .DEFAULT_COLORS
211227 if (dim(y )[1 ] > 1 && ! .is_rgb(y )) {
212228 nms <- unlist(channels(y ))[idx <- .ch_idx(y , ch )]
213229 pal <- pal [seq_along(idx )]; names(pal ) <- nms
214230 }
231+ # physical space mapping
232+ wh <- .get_wh(y )
215233 .gg_i(df , wh $ w , wh $ h , pal )
216234})
217235
@@ -221,5 +239,5 @@ setMethod("plotImage", "SpatialData", \(x, i=1, j=1, k=NULL, ch=NULL, c=NULL, cl
221239plotSpatialData <- \() ggplot() + coord_sf(expand = FALSE , reverse = " y" + .theme
222240# `annotation_raster` plots the array the same way it is printed, i.e., with the
223241# row 1 at the top, which means we need to flip the y-axis to have the correct axis labels.
224- # We tried flipping the image itself but it means everything gets out of alignement if
242+ # We tried flipping the image itself but it means everything gets out of alignment if
225243# the user sets `scale_y_reverse()` themselves.
0 commit comments