Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
21 changes: 15 additions & 6 deletions R/CTutils.R
Original file line number Diff line number Diff line change
Expand Up @@ -103,11 +103,21 @@ setMethod("CTname", "SpatialDataAttrs", \(x, ...) {

# SpatialDataElement ----

.SDE_METS <- c("axes", "CTlist", "CTtype", "CTname")
for (. in .SDE_METS) {
setMethod(., "SpatialDataElement",
eval(parse(text=sprintf("\\(x, ...) %s(meta(x), ...)", .))))
}
#' @rdname CTutils
#' @export
setMethod("axes", "SpatialDataElement", \(x, ...) axes(meta(x), ...))

#' @rdname CTutils
#' @export
setMethod("CTlist", "SpatialDataElement", \(x, ...) CTlist(meta(x), ...))

#' @rdname CTutils
#' @export
setMethod("CTtype", "SpatialDataElement", \(x, ...) CTtype(meta(x), ...))

#' @rdname CTutils
#' @export
setMethod("CTname", "SpatialDataElement", \(x, ...) CTname(meta(x), ...))

#' @rdname CTutils
#' @export
Expand Down Expand Up @@ -185,7 +195,6 @@ setMethod("addCT", "SpatialDataElement",
#' @rdname CTutils
#' @export
setMethod("addCT", "SpatialDataAttrs", \(x, name, type="identity", data=NULL) {
#x <- meta(image(sd, 2)); name <- "lowres"; type="identity"; data=NULL
stopifnot(
is.character(name), length(name) == 1,
is.character(type), length(type) == 1)
Expand Down
32 changes: 17 additions & 15 deletions R/SDattrs.R
Original file line number Diff line number Diff line change
@@ -1,11 +1,23 @@
#' @name SpatialDataAttrs
#' @title The `SpatialDataAttrs` class
#'
#' @aliases region region<-
#' @aliases regions regions<-
#' @aliases instances instances<-
#' @aliases region_key region_key<-
#' @aliases feature_key feature_key<-
#' @aliases instance_key instance_key<-
#'
#' @param x element or list extracted from a OME-NGFF compliant .zattrs file.
#' @param name character string for extraction (see ?base::`$`).
#' @param type character string; either "array" (image/label) or "frame" (point/shape).
#' @param axes list of axes; if NULL, defaults to cyx (array) or xy (frame).
#' @param transformations list of transformations; if NULL, defaults to global identity.
#' @param label flag; when \code{type="frame"}, should attributes be for a label?
#' @param trans list of coordinate transformations; defaults to identity only.
#' @param value character string (for one \code{region} and \code{_key}s),
#' or vector (for many \code{region}s, \code{instances} and \code{regions}).
#' @param ver character string; specified the .zarr version to comply with.
#' @param nch scalar integer; how many channels should there be?
#' (ignored unless \code{type="frame"} and \code{label=FALSE}).
#' @param ... additional attributes (e.g., version, feature_key).
#'
#' @details
Expand Down Expand Up @@ -42,12 +54,12 @@
#' # constructor
#' SpatialDataAttrs(type="frame")
#' SpatialDataAttrs(type="array")
#' SpatialDataAttrs(type="array", n=7)
#' SpatialDataAttrs(type="array", nch=7)
#' SpatialDataAttrs(type="array", label=TRUE)
#'
#' @export
SpatialDataAttrs <- \(x, type=c("array", "frame"),
label=FALSE, trans=NULL, ver="0.4", n=3, ...)
label=FALSE, trans=NULL, ver="0.4", nch=3, ...)
{
if (!missing(x)) return(.SpatialDataAttrs(x))
type <- match.arg(type)
Expand All @@ -68,7 +80,7 @@ SpatialDataAttrs <- \(x, type=c("array", "frame"),
if (type == "array") {
# default structure
res <- list(
omero=list(channels=list(label=letters[seq_len(n)])),
omero=list(channels=list(label=letters[seq_len(nch)])),
multiscales=list(list(
axes=ax,
version="0.4",
Expand Down Expand Up @@ -126,20 +138,10 @@ setMethod("$", "SpatialDataAttrs", \(x, name) x[[name]])
#' @noRd
.ms <- \(x) switch(.zv(x), "0.3"=x$ome$multiscales, x$multiscales)

# internal use only!
#' @noRd
.ch <- \(x) {
if (.zv(x) == "0.3") x <- x$ome
unlist(x$omero$channels)
}

# internal use only!
#' @noRd
setMethod("multiscales", "list", .ms)

#' @export
setMethod("channels", "SpatialDataAttrs", \(x, ...) .ch(x))

# features ----

#' @export
Expand Down
19 changes: 18 additions & 1 deletion R/SpatialData.R
Original file line number Diff line number Diff line change
@@ -1,7 +1,24 @@
#' @name SpatialData
#' @title The `SpatialData` class
#'
#' @description ...
#' @aliases data meta layer element
#' @aliases image label point shape table
#' @aliases images labels points shapes tables
#' @aliases image<- label<- point<- shape<- table<-
#' @aliases images<- labels<- points<- shapes<- tables<-
#' @aliases imageNames labelNames pointNames shapeNames tableNames
#' @aliases imageNames<- labelNames<- pointNames<- shapeNames<- tableNames<-
#' @aliases [[<-,SpatialData,character,ANY-method
#' @aliases [[<-,SpatialData,numeric,ANY-method
#'
#' @description
#' \code{SpatialData} provides an R interface to Python's \code{spatialdata},
#' which enables the representation of diverse spatial omics datasets using
#' the OME-NGFF (Next Generation File Format) standard. In R,
#' \itemize{
#' \item images and labels are \code{ZarrArray}s (\code{Rarr} package).
#' \item points and shapes are managed using \code{duckspatial} tables.
#' \item tables are \code{SingleCellExperiment}s (read with \code{anndataR}).}
#'
#' @param images list of \code{\link{SpatialDataImage}}s
#' @param labels list of \code{\link{SpatialDataLabel}}s
Expand Down
74 changes: 37 additions & 37 deletions R/combine.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,42 +17,42 @@
#' imageNames(y)
#' region(table(y, 1))
#' region(table(y, 2))
#'
#' @importFrom BiocGenerics combine
NULL

#' @export
setMethod("combine",
c("SpatialData", "SpatialData"),
\(x, y, ...) {
# ensure element names are unique across objects
old <- list(unlist(colnames(x)), unlist(colnames(y)))
idx <- rep.int(c(1, 2), vapply(old, length, integer(1)))
new <- split(make.unique(unlist(old)), idx)
for (i in c(1, 2)) {
z <- get(c("x", "y")[i])
layer_nms <- setdiff(rownames(z), "tables")
old_nms <- unlist(colnames(z)[layer_nms])
# find new names for these elements
j <- match(old_nms, old[[i]])
new_nms <- new[[i]][j]

# rename elements
for (l in layer_nms) {
j <- match(names(z[[l]]), old[[i]])
names(z[[l]]) <- new[[i]][j]
}
# sync tables
z <- .sync_tables(z, old_nms, new_nms)

# rename tables themselves
j <- match(tableNames(z), old[[i]])
tableNames(z) <- new[[i]][j]

assign(c("x", "y")[i], z)
#' @rdname combine
#' @importFrom BiocGenerics combine
setMethod("combine", c("SpatialData", "SpatialData"), \(x, y, ...) {
# ensure element names are unique across objects
old <- list(unlist(colnames(x)), unlist(colnames(y)))
idx <- rep.int(c(1, 2), vapply(old, length, integer(1)))
new <- split(make.unique(unlist(old)), idx)
for (i in c(1, 2)) {
z <- get(c("x", "y")[i])
layer_nms <- setdiff(rownames(z), "tables")
old_nms <- unlist(colnames(z)[layer_nms])
# find new names for these elements
j <- match(old_nms, old[[i]])
new_nms <- new[[i]][j]

# rename elements
for (l in layer_nms) {
j <- match(names(z[[l]]), old[[i]])
names(z[[l]]) <- new[[i]][j]
}
SpatialData(
images=c(x$images, y$images),
labels=c(x$labels, y$labels),
points=c(x$points, y$points),
shapes=c(x$shapes, y$shapes),
tables=c(x$tables, y$tables))
})
# sync tables
z <- .sync_tables(z, old_nms, new_nms)

# rename tables themselves
j <- match(tableNames(z), old[[i]])
tableNames(z) <- new[[i]][j]

assign(c("x", "y")[i], z)
}
SpatialData(
images=c(x$images, y$images),
labels=c(x$labels, y$labels),
points=c(x$points, y$points),
shapes=c(x$shapes, y$shapes),
tables=c(x$tables, y$tables))
})
1 change: 1 addition & 0 deletions R/mask.R
Original file line number Diff line number Diff line change
Expand Up @@ -163,6 +163,7 @@ setMethod(".mask", c("SpatialDataShape", "SpatialDataShape"), \(i, j, how=NULL,
if (nrow(collect(head(ij, 1))) == 0)
stop("found no intersections",
" between shapes 'i' and 'j'")
id_x <- id_y <- NULL # R CMD check
is <- pull(ij, id_y) # elements in i
js <- pull(ij, id_x) # masks in j
na <- setdiff(seq_len(nrow(i)), is)
Expand Down
22 changes: 17 additions & 5 deletions R/methods.R
Original file line number Diff line number Diff line change
@@ -1,14 +1,14 @@
#' @importFrom utils .DollarNames
#' @export
#' @importFrom utils .DollarNames
.DollarNames.SpatialData <- \(x, pattern="") grep(pattern, .LAYERS, value=TRUE)

#' @rdname SpatialData
#' @exportMethod $
#' @rdname SpatialData
setMethod("$", "SpatialData", \(x, name) attr(x, name))

#' @export
#' @rdname SpatialData
#' @importFrom methods callNextMethod
#' @export
setMethod("[[", c("SpatialData", "numeric"), \(x, i, ...) {
i <- .LAYERS[i]
callNextMethod(x, i)
Expand Down Expand Up @@ -144,12 +144,24 @@ setMethod("element", c("SpatialData", "ANY"), \(x, i)

# get all ----

#' @name SpatialData
#' @exportMethod images labels points shapes tables
#' @export
#' @rdname SpatialData
setMethod("images", "SpatialData", \(x) x$images)

#' @export
#' @rdname SpatialData
setMethod("labels", "SpatialData", \(x) x$labels)

#' @export
#' @rdname SpatialData
setMethod("points", "SpatialData", \(x) x$points)

#' @export
#' @rdname SpatialData
setMethod("shapes", "SpatialData", \(x) x$shapes)

#' @export
#' @rdname SpatialData
setMethod("tables", "SpatialData", \(x) x$tables)

# get nms ----
Expand Down
7 changes: 2 additions & 5 deletions R/read.R
Original file line number Diff line number Diff line change
Expand Up @@ -12,10 +12,6 @@
#' Control which elements should be read for each layer.
#' The default, NULL, reads all elements; alternatively, may be FALSE
#' to skip a layer, or a integer vector specifying which elements to read.
#' @param anndataR logical specifying whether
#' to use \code{anndataR} to read tables;
#' defaults to FALSE in `readSpatialData`, and `readTable`,
#' so that pythonic \code{anndata} are used.
#' @param ... option arguments passed to and from other methods.
#'
#' @return
Expand Down Expand Up @@ -146,6 +142,7 @@ readSpatialData <- function(x,
lapply(j, \(.) do.call(f, list(.)))
}

sd <- lapply(setNames(nm=.LAYERS[!skip]), .readLayer)
names(ls) <- ls <- .LAYERS[!skip]
sd <- lapply(ls, .readLayer)
do.call(SpatialData, sd)
}
Loading
Loading