Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

cbind: unique/duplicated colnamesare left asis/made unique; read10xVisium: keep barcodes as colData; spatialCoords/<-: withDimnames argument #128

Open
wants to merge 12 commits into
base: devel
Choose a base branch
from
Open
6 changes: 3 additions & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
Package: SpatialExperiment
Version: 1.9.3
Version: 1.9.4
Title: S4 Class for Spatially Resolved -omics Data
Description: Defines an S4 class for storing data from spatial -omics experiments.
The class extends SingleCellExperiment to
The class extends SingleCellExperiment to
support storage and retrieval of additional information from spot-based and
molecule-based platforms, including spatial coordinates, images, and
image metadata. A specialized constructor function is included for data
Expand Down Expand Up @@ -49,4 +49,4 @@ Suggests:
BiocStyle,
BumpyMatrix
VignetteBuilder: knitr
RoxygenNote: 7.2.1
RoxygenNote: 7.2.2
4 changes: 2 additions & 2 deletions R/AllGenerics.R
Original file line number Diff line number Diff line change
Expand Up @@ -48,10 +48,10 @@ setGeneric("spatialDataNames", function(x) standardGeneric("spatialDataNames"))
setGeneric("spatialDataNames<-", function(x, value) standardGeneric("spatialDataNames<-"))

#' @export
setGeneric("spatialCoords", function(x, ...) standardGeneric("spatialCoords"))
setGeneric("spatialCoords", function(x, withDimnames=TRUE, ...) standardGeneric("spatialCoords"))

#' @export
setGeneric("spatialCoords<-", function(x, value) standardGeneric("spatialCoords<-"))
setGeneric("spatialCoords<-", function(x, value, withDimnames=TRUE) standardGeneric("spatialCoords<-"))

#' @export
setGeneric("spatialCoordsNames", function(x) standardGeneric("spatialCoordsNames"))
Expand Down
5 changes: 5 additions & 0 deletions R/SpatialExperiment-combine.R → R/SpatialExperiment-cbind.R
Original file line number Diff line number Diff line change
Expand Up @@ -103,6 +103,11 @@ setMethod("cbind", "SpatialExperiment", function(..., deparse.level=1) {
out <- do.call(
callNextMethod,
c(args, list(deparse.level=1)))
if (any(duplicated(colnames(out)))) {
n <- vapply(args, ncol, integer(1))
n <- rep.int(seq_along(args), n)
colnames(out) <- paste(n, colnames(out), sep="_")
}

# merge 'imgData' from multiple samples
if (!is.null(imgData(args[[1]]))) {
Expand Down
69 changes: 6 additions & 63 deletions R/SpatialExperiment-methods.R
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,12 @@
#' identifier(s) for \code{scaleFactors}. Default = \code{TRUE} (all samples).
#' @param image_id Logical value or character vector specifying image
#' identifier(s) for \code{scaleFactors}. Default = \code{TRUE} (all images).
#' @param withDimnames Logical value indicating whether dimnames of the
#' \code{spatialExperiment} should be applied or checked against.
#' If \code{withDimnames=TRUE}, non-\code{NULL} \code{rownames(value)}
#' are checked against \code{colnames(x)}, and an error occurs if these
#' don't match. Else, discrepancies in rownames are ignored.
#' (see also \code{\link[SingleCellExperiment]{reducedDims}})
#' @param name The name of the \code{colData} column to extract.
#'
#' @details
Expand Down Expand Up @@ -184,69 +190,6 @@ setReplaceMethod("spatialDataNames",
}
)

# spatialCoords ----------------------------------------------------------------

#' @rdname SpatialExperiment-methods
#' @importFrom SingleCellExperiment int_colData<-
#' @export
setMethod("spatialCoords",
"SpatialExperiment",
function(x) int_colData(x)$spatialCoords)

#' @rdname SpatialExperiment-methods
#' @importFrom SingleCellExperiment int_colData<-
#' @export
setReplaceMethod("spatialCoords",
c("SpatialExperiment", "matrix"),
function(x, value) {
stopifnot(
is.numeric(value),
nrow(value) == ncol(x))
int_colData(x)$spatialCoords <- value
return(x)
}
)

#' @rdname SpatialExperiment-methods
#' @export
setReplaceMethod("spatialCoords",
c("SpatialExperiment", "NULL"),
function(x, value) {
value <- matrix(numeric(), ncol(x), 0)
`spatialCoords<-`(x, value)
}
)

# spatialCoordsNames -----------------------------------------------------------

#' @rdname SpatialExperiment-methods
#' @importFrom SingleCellExperiment int_colData
#' @export
setMethod("spatialCoordsNames",
"SpatialExperiment",
function(x) colnames(int_colData(x)$spatialCoords))

#' @rdname SpatialExperiment-methods
#' @importFrom SingleCellExperiment int_colData<-
#' @export
setReplaceMethod("spatialCoordsNames",
c("SpatialExperiment", "character"),
function(x, value) {
colnames(int_colData(x)$spatialCoords) <- value
return(x)
}
)

#' @rdname SpatialExperiment-methods
#' @export
setReplaceMethod("spatialCoordsNames",
c("SpatialExperiment", "NULL"),
function(x, value) {
value <- character()
`spatialCoordsNames<-`(x, value)
}
)

# scaleFactors -----------------------------------------------------------------

#' @rdname SpatialExperiment-methods
Expand Down
8 changes: 3 additions & 5 deletions R/read10xVisium.R
Original file line number Diff line number Diff line change
Expand Up @@ -190,13 +190,11 @@ read10xVisium <- function(samples="",
cnms <- c(
"barcode", "in_tissue", "array_row", "array_col",
"pxl_row_in_fullres", "pxl_col_in_fullres")
df <- lapply(seq_along(x), function(i)
{
df <- read.csv(x[i],
header=!grepl("list", x[i]),
row.names=1, col.names=cnms)
df <- lapply(seq_along(x), function(i) {
df <- read.csv(x[i], header=!grepl("list", x[i]), col.names=cnms)
if (length(x) > 1) rownames(df) <- paste(i, rownames(df), sep="_")
if (!is.null(names(x))) cbind(sample_id=names(x)[i], df)
rownames(df) <- df$barcode
df
})
df <- do.call(rbind, df)
Expand Down
76 changes: 76 additions & 0 deletions R/spatialCoords.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,76 @@

# spatialCoords ----------------------------------------------------------------

#' @rdname SpatialExperiment-methods
#' @importFrom SingleCellExperiment int_colData<-
#' @export
setMethod("spatialCoords",
"SpatialExperiment",
function(x, withDimnames=TRUE) {
out <- int_colData(x)$spatialCoords
if (withDimnames)
rownames(out) <- colnames(x)
return(out)
})

#' @rdname SpatialExperiment-methods
#' @importFrom SingleCellExperiment int_colData<-
#' @export
setReplaceMethod("spatialCoords",
c("SpatialExperiment", "matrix"),
Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

there is a warning that I suppose is coming from the "matrix" instead of a "value"

Warning:     ‘spatialCoords<-’
    ‘\S4method{spatialCoords<-}{SpatialExperiment,NULL}’
    ‘\S4method{spatialCoords<-}{SpatialExperiment,matrix}’
  The argument of a replacement function which corresponds to the right
  hand side must be named ‘value’.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yeah I saw. But I don’t understand because it’s good locally. I’m on it…

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

indeed I don't get why, but have you tried something like: c("SpatialExperiment", "value") ?

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think that's because the generic is defined as setGeneric("spatialCoords<-", function(x, value, withDimnames=TRUE) standardGeneric("spatialCoords<-"))

Copy link
Collaborator Author

@HelenaLC HelenaLC Nov 22, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

…the signature has to be classes, so “NULL” and “matrix” (not “value”) is correct. It’s saying the generic and methods don’t match. But I don’t see why not as they both have “value” in the function definition in the same order…

Copy link
Owner

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

yes, I saw that, I'm looking over the internet, but still I'm not able to understand the motivation for this warning.

function(x, value, withDimnames=TRUE) {
stopifnot(
is.numeric(value),
nrow(value) == ncol(x))
new <- rownames(value)
if (!is.null(new) && withDimnames) {
if (!identical(new, colnames(x))) {
stop("Non-NULL 'rownames(value)' should be the",
" same as 'colnames(x)' for 'spatialCoords<-'.",
" Use 'withDimnames=FALSE' to force replacement.")
}
}
int_colData(x)$spatialCoords <- value
return(x)
}
)

#' @rdname SpatialExperiment-methods
#' @export
setReplaceMethod("spatialCoords",
c("SpatialExperiment", "NULL"),
function(x, value, withDimnames=TRUE) {
value <- matrix(numeric(), ncol(x), 0)
`spatialCoords<-`(x, value)
}
)

# spatialCoordsNames -----------------------------------------------------------

#' @rdname SpatialExperiment-methods
#' @importFrom SingleCellExperiment int_colData
#' @export
setMethod("spatialCoordsNames",
"SpatialExperiment",
function(x) colnames(int_colData(x)$spatialCoords))

#' @rdname SpatialExperiment-methods
#' @importFrom SingleCellExperiment int_colData<-
#' @export
setReplaceMethod("spatialCoordsNames",
c("SpatialExperiment", "character"),
function(x, value) {
colnames(int_colData(x)$spatialCoords) <- value
return(x)
}
)

#' @rdname SpatialExperiment-methods
#' @export
setReplaceMethod("spatialCoordsNames",
c("SpatialExperiment", "NULL"),
function(x, value) {
value <- character()
`spatialCoordsNames<-`(x, value)
}
)
2 changes: 1 addition & 1 deletion man/SpatialExperiment-combine.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

42 changes: 25 additions & 17 deletions man/SpatialExperiment-methods.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

13 changes: 12 additions & 1 deletion tests/testthat/test_SpatialExperiment-cbind.R
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@ test_that("duplicated sample_ids are made unique with a message", {
expect_true(nrow(new) == nrow(spe))
expect_true(ncol(new) == 2*ncol(spe))
expect_identical(rownames(new), rownames(spe))
expect_setequal(colnames(new), colnames(spe))
})

test_that("imgData are combined correctly", {
Expand All @@ -33,3 +32,15 @@ test_that("imgData are combined correctly", {
expect_identical(imgData(spe3)[one, ], imgData(spe1))
expect_identical(imgData(spe3)[two, ], imgData(spe2))
})

test_that("unique colnames are left asis,", {
tmp <- spe
colnames(tmp) <- paste0(colnames(tmp), "x")
out <- cbind(spe, tmp)
expect_false(any(duplicated(colnames(out))))
})

test_that("duplicated colnames are made unique", {
out <- cbind(spe, spe)
expect_false(any(duplicated(colnames(out))))
})
22 changes: 0 additions & 22 deletions tests/testthat/test_SpatialExperiment-methods.R
Original file line number Diff line number Diff line change
Expand Up @@ -45,28 +45,6 @@ test_that("spatialDataNames()<-,NULL", {
expect_identical(new, character(0))
})

test_that("spatialCoordsNames()", {
expect_identical(
spatialCoordsNames(spe),
colnames(int_colData(spe)$spatialCoords))
})

test_that("spatialCoordsNames<-,character", {
old <- spatialCoordsNames(spe)
new <- sample(letters, length(old))
spatialCoordsNames(spe) <- new
expect_identical(spatialCoordsNames(spe), new)
expect_identical(spatialCoordsNames(spe),
colnames(int_colData(spe)$spatialCoords))
})

test_that("spatialCoordsNames<-,NULL", {
old <- spatialCoords(spe)
spatialCoordsNames(spe) <- NULL
expect_null(spatialCoordsNames(spe))
expect_equivalent(spatialCoords(spe), old)
})

test_that("scaleFactors()", {
sfs <- scaleFactors(spe, sample_id=TRUE, image_id=TRUE)
expect_is(sfs, "numeric")
Expand Down
Loading