From 4d13381edf27be2bf20daee1cdd2927f1298499b Mon Sep 17 00:00:00 2001 From: Lambda Moses Date: Thu, 19 Sep 2024 00:50:21 -0400 Subject: [PATCH] Use mcols for colFeatureData, closing #49 --- DESCRIPTION | 4 ++-- NAMESPACE | 2 ++ R/featureData.R | 34 +++++++++++------------------- R/updateObject.R | 15 ++++++++----- man/colFeatureData.Rd | 8 +++---- tests/testthat/test-updateObject.R | 11 ++++++++-- 6 files changed, 39 insertions(+), 35 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e3b28c0f..d3291ccf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: SpatialFeatureExperiment Type: Package Title: Integrating SpatialExperiment with Simple Features in sf -Version: 1.7.2 +Version: 1.7.3 Authors@R: c(person("Lambda", "Moses", email = "dl3764@columbia.edu", role = c("aut", "cre"), @@ -93,7 +93,7 @@ Suggests: sparseMatrixStats, testthat (>= 3.0.0), tidyr, - Voyager, + Voyager (>= 1.7.2), xml2 Remotes: Voyager=github::pachterlab/voyager diff --git a/NAMESPACE b/NAMESPACE index f9a20f1c..a26b64c1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -240,12 +240,14 @@ importFrom(EBImage,Image) importFrom(Matrix,colSums) importFrom(Matrix,rowSums) importFrom(Matrix,sparseMatrix) +importFrom(S4Vectors,"mcols<-") importFrom(S4Vectors,"metadata<-") importFrom(S4Vectors,DataFrame) importFrom(S4Vectors,SimpleList) importFrom(S4Vectors,combineCols) importFrom(S4Vectors,isEmpty) importFrom(S4Vectors,make_zero_col_DFrame) +importFrom(S4Vectors,mcols) importFrom(S4Vectors,metadata) importFrom(S4Vectors,setValidity2) importFrom(S4Vectors,showAsCell) diff --git a/R/featureData.R b/R/featureData.R index b9d9f4db..4d5f65bc 100644 --- a/R/featureData.R +++ b/R/featureData.R @@ -1,29 +1,19 @@ -.initDF <- function(m) { - rownames_use <- colnames(m) - fd <- make_zero_col_DFrame(nrow = ncol(m)) - rownames(fd) <- rownames_use - fd -} - -#' @importFrom S4Vectors combineCols +#' @importFrom S4Vectors combineCols mcols mcols<- .format_fd <- function(x, MARGIN, value = NULL) { - fd_name <- "featureData" dimData <- switch(MARGIN, rowData, colData) - if (is.null(value)) fd <- metadata(dimData(x))[[fd_name]] else fd <- value - if (!is.null(fd)) { - fd <- fd[intersect(rownames(fd), colnames(dimData(x))),, drop = FALSE] - empty <- .initDF(dimData(x)) - fd <- combineCols(empty, fd) - } + fd <- value[intersect(rownames(value), colnames(dimData(x))),, drop = FALSE] + empty <- make_zero_col_DFrame(ncol(dimData(x))) + rownames(empty) <- colnames(dimData(x)) + fd <- combineCols(empty, fd) return(fd) } -#' Get global spatial analysis results and metadata of colData, rowData, and geometries +#' Get global spatial analysis results and metadata of colData, rowData, and +#' geometries #' #' Results of spatial analyses on columns in \code{colData}, \code{rowData}, and -#' geometries are stored in their metadata, which can be accessed by the -#' \code{\link{metadata}} function. The \code{colFeaturedata} function allows -#' the users to more directly access these results. +#' geometries are stored in their metadata. The \code{colFeaturedata} function +#' allows the users to more directly access these results. #' #' @param sfe An SFE object. #' @param type Which geometry, can be name (character) or index (integer) @@ -47,19 +37,19 @@ #' sfe <- colDataMoransI(sfe, "nCounts") #' colFeatureData(sfe) colFeatureData <- function(sfe) { - .format_fd(sfe, 2L) + mcols(colData(sfe)) } `colFeatureData<-` <- function(sfe, value) { if (!is.null(value)) value <- .format_fd(sfe, 2L, value) - metadata(colData(sfe))$featureData <- value + mcols(colData(sfe)) <- value sfe } #' @rdname colFeatureData #' @export rowFeatureData <- function(sfe) { - .format_fd(sfe, 1L) + mcols(rowData(sfe)) } #' @rdname colFeatureData diff --git a/R/updateObject.R b/R/updateObject.R index 1dd47110..d24611c7 100644 --- a/R/updateObject.R +++ b/R/updateObject.R @@ -33,11 +33,10 @@ setMethod("updateObject", "SpatialFeatureExperiment", triggered <- FALSE curr_version <- packageVersion("SpatialFeatureExperiment") if (is.null(old_version)) { - # Meaning prior to 1.1.4, i.e. the first version - old_version <- package_version("1.0.0") - #int_metadata(object)$SFE_version <- curr_version - triggered <- TRUE + # There's an update to colFeatureData in 1.7.3 + old_version <- package_version("1.7.2") } + if (old_version < package_version("1.7.3")) triggered <- TRUE if (verbose && triggered) { message("[updateObject] ", class(object)[1], " object uses ", "internal representation\n", @@ -45,9 +44,15 @@ setMethod("updateObject", "SpatialFeatureExperiment", old_version, ". ", "Updating it to version ", curr_version, "\n", appendLF = FALSE) } + if (triggered) { + if (!is.null(metadata(colData(object))$featureData)) { + fd <- metadata(colData(object))$featureData + colFeatureData(object) <- fd + metadata(colData(object))$featureData <- NULL + } + } int_metadata(object)$SFE_version <- curr_version callNextMethod() - #object }) #' @rdname updateObject diff --git a/man/colFeatureData.Rd b/man/colFeatureData.Rd index cec77d4c..33a1b849 100644 --- a/man/colFeatureData.Rd +++ b/man/colFeatureData.Rd @@ -5,7 +5,8 @@ \alias{rowFeatureData} \alias{geometryFeatureData} \alias{reducedDimFeatureData} -\title{Get global spatial analysis results and metadata of colData, rowData, and geometries} +\title{Get global spatial analysis results and metadata of colData, rowData, and +geometries} \usage{ colFeatureData(sfe) @@ -31,9 +32,8 @@ A \code{DataFrame}. } \description{ Results of spatial analyses on columns in \code{colData}, \code{rowData}, and -geometries are stored in their metadata, which can be accessed by the -\code{\link{metadata}} function. The \code{colFeaturedata} function allows -the users to more directly access these results. +geometries are stored in their metadata. The \code{colFeaturedata} function +allows the users to more directly access these results. } \examples{ library(SpatialFeatureExperiment) diff --git a/tests/testthat/test-updateObject.R b/tests/testthat/test-updateObject.R index ffae8ce8..d5da8621 100644 --- a/tests/testthat/test-updateObject.R +++ b/tests/testthat/test-updateObject.R @@ -1,5 +1,3 @@ -library(SFEData) - sfe <- readRDS(system.file("extdata/sfe_visium.rds", package = "SpatialFeatureExperiment")) test_that("SFEVersion of first version of SFE object should be NULL", { expect_null(SFEVersion(sfe)) @@ -11,3 +9,12 @@ test_that("Add version in updateObject", { paste0("Updating it to version ", curr_version)) expect_equal(SFEVersion(sfe), curr_version) }) + +test_that("Update colFeatureData if present", { + df <- DataFrame(foo = 1, row.names = "sample_id") + metadata(colData(sfe))$featureData <- df + sfe <- updateObject(sfe) + df2 <- colFeatureData(sfe) + expect_equal(df, df2) + expect_null(metadata(colData(sfe))$featureData) +})