Use mcols for colFeatureData, closing #49

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 = "[email protected]", 
     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

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)

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

R/updateObject.R

@@ -33,21 +33,26 @@ 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",
                           "[updateObject] from 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

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)
+})