Merge branch 'devel' of https://github.com/pachterlab/SpatialFeatureE…

…xperiment into devel

R/aggregate.R

@@ -51,7 +51,7 @@ aggregateTx <- function(file, df = NULL, by = NULL, sample_id = "sample01",
     if (is.null(by))
         by <- st_make_grid(mols, cellsize = cellsize, square = square,
                            flat_topped = flat_topped)
-    else if (is(by, "sf")) by <- st_geometry(by)
+    else if (inherits(by, "sf")) by <- st_geometry(by)
     grid_sf <- st_sf(grid_id = seq_along(by), geometry = by)
     mols <- st_join(mols, grid_sf) # Took 5.87 minutes for 7171453 spots and 8555 bins
     mols <- st_drop_geometry(mols) |> as.data.table()
@@ -144,7 +144,7 @@ aggregateTxTech <- function(data_dir, df = NULL, by = NULL,
         out_agg <- matrix(unlist(out_agg), ncol = length(inds))
         rownames(out_agg) <- rownames(mat)
     } else stop("Function ", fun_name, " not supported for aggregating SFE.")
-    if (is(out_agg, "dgeMatrix")) out_agg <- as.matrix(out_agg)
+    if (inherits(out_agg, "dgeMatrix")) out_agg <- as.matrix(out_agg)
     out_agg
 }
 
@@ -264,20 +264,20 @@ aggregateTxTech <- function(data_dir, df = NULL, by = NULL,
             by <- .make_grid_samples(x, sample_id,
                                      cellsize, square, flat_topped)
         }
-        if (is.list(by) && !is(by, "sfc")) {
+        if (is.list(by) && !inherits(by, "sfc")) {
             if (!any(sample_id %in% names(by)))
                 stop("None of the geometries in `by` correspond to sample_id")
             by <- by[intersect(sample_id, names(by))]
         } else {
-            if (!is(by, "sfc") && !is(by, "sf"))
+            if (!inherits(by, "sfc") && !inherits(by, "sf"))
                 stop("`by` must be either sf or sfc.")
             if (length(sample_id) > 1L) {
-                if (is(by, "sfc") || !"sample_id" %in% names(by))
+                if (inherits(by, "sfc") || !"sample_id" %in% names(by))
                     stop("`by` must be an sf data frame with a column `sample_id`")
                 by <- split(st_geometry(by), by$sample_id)
             }
         }
-        if (is(by, "sfc")) by <- setNames(list(by), sample_id)
+        if (inherits(by, "sfc")) by <- setNames(list(by), sample_id)
         fun_name <- as.character(substitute(FUN))
         sfes <- splitSamples(x) # Output list should have sample IDs as names
         sfes <- lapply(sample_id, function(s) {

R/coerce.R

@@ -31,7 +31,7 @@
             is_sfe_img <- class(img)[1] %in% c("SpatRasterImage", "ExtImage", "BioFormatsImage")
             if (is_sfe_img) {
                 im_new <- img
-            } else if (is(img, "LoadedSpatialImage")) {
+            } else if (inherits(img, "LoadedSpatialImage")) {
                 im <- imgRaster(img)
                 rgb_v <- col2rgb(im)
                 nrow <- dim(im)[2]
@@ -42,7 +42,7 @@
                 arr <- simplify2array(list(r, g, b))
                 im_new <- rast(arr)
                 terra::RGB(im_new) <- seq_len(3)
-            } else if (is(img, "RemoteSpatialImage") || is(img, "StoredSpatialImage")) {
+            } else if (inherits(img, "RemoteSpatialImage") || inherits(img, "StoredSpatialImage")) {
                 suppressWarnings(im_new <- rast(imgSource(img)))
                 if (packageVersion('terra') >= as.package_version("1.7.83"))
                     im_new <- terra::flip(im_new)
@@ -228,10 +228,10 @@ setMethod("toSpatialFeatureExperiment", "SingleCellExperiment",
 .GetSlotNames <- function(object_seu, assay_seu, fov_number) {
     slot_n <-
         Seurat::GetAssay(object_seu, assay_seu)
-    if (is(slot_n, "Assay")) {
+    if (inherits(slot_n, "Assay")) {
         # Seurat v4 based object
         slot_n <- slotNames(x = slot_n)[1:2]
-    } else if (is(slot_n, "Assay5")) {
+    } else if (inherits(slot_n, "Assay5")) {
         # Seurat v5 based object
         slot_n <- slot(slot_n, name = slotNames(x = slot_n)[1]) |> names()
     }
@@ -252,7 +252,7 @@ setMethod("toSpatialFeatureExperiment", "SingleCellExperiment",
 
 # internal metadata getter for Seurat and SFE objects
 .getMeta <- function(object = NULL) {
-    if (is(object, "Seurat")) {
+    if (inherits(object, "Seurat")) {
         return(slot(object, "meta.data"))
     } else {
         return(colData(object) |>
@@ -605,7 +605,7 @@ setMethod("toSpatialFeatureExperiment", "SingleCellExperiment",
               # subset transcripts keep on
               mols <- mols[mols$ID %in% rownames(sfe),]
             }
-            if (is(mols, "sf")) {
+            if (inherits(mols, "sf")) {
               rownames(mols) <- unique(mols$ID)
               txSpots(sfe, withDimnames = TRUE) <- mols
               # add sample id

R/df2sf.R

@@ -259,13 +259,13 @@ df2sf <- function(df, spatialCoordsNames = c("x", "y"), spotDiameter = NA,
                            spotDiameter = NA, geometryType = "POLYGON",
                            group_col = "group", id_col = "ID", subid_col = "subID",
                            check = TRUE) {
-    if (!is.null(x) && !is(x, "sf") && !is.data.frame(x) && !is.matrix(x)) {
+    if (!is.null(x) && !inherits(x, "sf") && !is.data.frame(x) && !is.matrix(x)) {
         stop(
             "Each element of the list for *Geometry must be an ",
             "sf object or a data frame or a matrix."
         )
     }
-    if (is(x, "sf") || is.null(x)) {
+    if (inherits(x, "sf") || is.null(x)) {
         return(x)
     } else if (is.data.frame(x) || is.matrix(x)) {
         return(df2sf(x, spatialCoordsNames, spotDiameter, geometryType,
@@ -277,7 +277,7 @@ df2sf <- function(df, spatialCoordsNames = c("x", "y"), spotDiameter = NA,
                         spotDiameter = NA, geometryType = "POLYGON",
                         group_col = "group", id_col = "ID", subid_col = "subID",
                         check = TRUE) {
-    x_is_sf <- vapply(x, function(t) is(t, "sf"), FUN.VALUE = logical(1))
+    x_is_sf <- vapply(x, function(t) inherits(t, "sf"), FUN.VALUE = logical(1))
     if (all(x_is_sf)) {
         return(x)
     }

R/formatTxSpots.R

@@ -191,7 +191,7 @@ addSelectTx <- function(sfe, file, gene_select, sample_id = 1L,
     gene_select <- .id2symbol(sfe, gene_select, swap_rownames)
     mols <- readSelectTx(file, gene_select, z, z_option)
     rownames(mols) <- .symbol2id(sfe, rownames(mols), swap_rownames)
-    if (!is(mols, "sf")) {
+    if (!inherits(mols, "sf")) {
         rowGeometries(sfe, sample_id = sample_id, partial = TRUE) <- mols
     } else {
         txSpots(sfe, sample_id, partial = TRUE) <- mols
@@ -385,7 +385,7 @@ formatTxSpots <- function(file, dest = c("rowGeometry", "colGeometry"),
                        gene_col = gene_col, cell_col = cell_col,
                        not_in_cell_id = not_in_cell_id, split_col = split_col)
         # If list of list, i.e. colGeometry, or do split
-        if (!is(mols[[1]], "sf")) {
+        if (!inherits(mols[[1]], "sf")) {
             names_use <- lapply(names(mols), function(n) {
                 names_int <- names(mols[[n]])
                 paste0(names_int, "_z", n)
@@ -409,7 +409,7 @@ formatTxSpots <- function(file, dest = c("rowGeometry", "colGeometry"),
         message(">>> Writing reformatted transcript spots to disk")
         if (!dir.exists(dirname(file_out)))
             dir.create(dirname(file_out))
-        if (is(mols, "sf")) {
+        if (inherits(mols, "sf")) {
             suppressWarnings(sfarrow::st_write_parquet(mols, file_out))
             if (!return) return(file_out)
         } else {
@@ -442,9 +442,9 @@ addTxSpots <- function(sfe, file, sample_id = 1L,
                           min_phred = min_phred, split_col = split_col,
                           flip = flip, z_option = z_option, file_out = file_out,
                           BPPARAM = BPPARAM, return = TRUE)
-    if (is(mols, "sf")) {
+    if (inherits(mols, "sf")) {
         txSpots(sfe, withDimnames = TRUE) <- mols
-    } else if (is(mols, "list")) {
+    } else if (inherits(mols, "list")) {
         rowGeometries(sfe) <- mols
     }
 

R/geometry_operation.R

@@ -342,7 +342,7 @@ annotSummary <- function(sfe, colGeometryName = 1L, annotGeometryName = 1L,
 }
 
 .bbox2sf <- function(bbox, sample_id) {
-    if (is.vector(bbox) || is(bbox, "bbox")) {
+    if (is.vector(bbox) || inherits(bbox, "bbox")) {
         bbox <- matrix(bbox, ncol = 1, dimnames = list(names(bbox), sample_id[1]))
     } else {
         samples_use <- intersect(colnames(bbox), sample_id)
@@ -431,7 +431,7 @@ crop <- function(x, y = NULL, colGeometryName = 1L, sample_id = "all",
         if (cover) st_covers else st_intersects
     }
     sample_id <- .check_sample_id(x, sample_id, one = FALSE)
-    if (!is(y, "sf") && !is(y, "sfc") && !is(y, "sfg")) {
+    if (!inherits(y, "sf") && !inherits(y, "sfc") && !inherits(y, "sfg")) {
         # y should be bbox, either named vector or matrix with samples in columns
         .check_bbox(y)
         if (is.matrix(y) && is.null(sample_id)) sample_id <- colnames(y)

R/image.R

@@ -874,19 +874,19 @@ setMethod("addImg", "SpatialFeatureExperiment",
 .get_imgData <- function(img, sample_id, image_id, extent = NULL,
                          scale_fct = 1, flip = FALSE) {
     # ExtImage
-    if (is(img, "Image")) {
-        if (is(img, "ExtImage")) spi <- img else spi <- ExtImage(img, extent)
+    if (inherits(img, "Image")) {
+        if (inherits(img, "ExtImage")) spi <- img else spi <- ExtImage(img, extent)
     } else {
         if (!.path_valid2(img))
             stop("img is not a valid file path.")
         e <- tryCatch(suppressWarnings(rast(img)), error = function(e) e)
-        if (is(e, "error") || grepl("\\.ome\\.tif", img)) {
+        if (inherits(e, "error") || grepl("\\.ome\\.tif", img)) {
             spi <- BioFormatsImage(img, extent)
             if (flip) spi <- mirrorImg(spi, direction = "vertical")
         } else {
             # What if extent is already present?
             w <- tryCatch(rast(img), warning = function(w) w)
-            if (is(w, "warning")) {
+            if (inherits(w, "warning")) {
                 # No extent in tif file
                 suppressWarnings(img <- rast(img))
                 if (!is.null(extent)) ext(img) <- extent[c("xmin", "xmax", "ymin", "ymax")]

R/int_dimData.R

@@ -201,7 +201,7 @@
     out <- lapply(template, function(x) {
         if (is.vector(x)) {
             out <- rep(NA, nrow)
-        } else if (is(x, "sfc")) {
+        } else if (inherits(x, "sfc")) {
             out <- st_sfc(lapply(seq_len(nrow), function(t) st_geometrycollection()))
         } else {
             # Only deal with columns that are themselves simple matrices
@@ -213,13 +213,13 @@
                 dimnames = list(rownames, colnames(x))
             )
             if (is.data.frame(x)) out <- as.data.frame(out)
-            if (is(x, "DFrame")) out <- DataFrame(out)
+            if (inherits(x, "DFrame")) out <- DataFrame(out)
             out <- I(out)
         }
         out
     })
     names(out) <- names(template)
-    S4 <- is(template, "DFrame")
+    S4 <- inherits(template, "DFrame")
     if (sf && S4) stop("Please use S3 data.frame for sf.")
     df_fun <- if (S4) DataFrame else data.frame
     out <- df_fun(out)
@@ -389,7 +389,7 @@
         geometry_type <- annotGeometryName
     }
 
-    if (is(value, "DFrame")) value <- as.list(value)
+    if (inherits(value, "DFrame")) value <- as.list(value)
     value <- .value2df(value, TRUE, feature = feature)
 
     g <- get_geom_fun(x, type = geometry_type, sample_id = "all")

R/internal-Voyager.R

@@ -13,7 +13,7 @@ NULL
 #' @export
 .value2df <- function(value, use_geometry, feature = NULL) {
     # Should return data frame for one type, each column is for a feature
-    if (!is.data.frame(value) && !is(value, "DFrame")) {
+    if (!is.data.frame(value) && !inherits(value, "DFrame")) {
         df_fun <- if (use_geometry) data.frame else DataFrame
         if (is.list(value)) {
             value <- lapply(

R/read.R

@@ -1044,7 +1044,7 @@ readCosMX <- function(data_dir,
 # helper function to convert from raw bytes to character
 .rawToChar_df <- function(input_df, BPPARAM = SerialParam()) {
     convert_ids <-
-        lapply(input_df, function(x) is(x, "arrow_binary")) |> unlist() |> which()
+        lapply(input_df, function(x) inherits(x, "arrow_binary")) |> unlist() |> which()
     if (any(convert_ids)) {
         message(">>> Converting columns with raw bytes (ie 'arrow_binary') to character")
         cols_converted <-
@@ -1058,7 +1058,7 @@ readCosMX <- function(data_dir,
             input_df[,convert_ids][[i]] <- unlist(cols_converted[[i]])
         }
     }
-    if (!is(input_df, "data.table")) {
+    if (!inherits(input_df, "data.table")) {
         input_df <- data.table::as.data.table(input_df)
     }
     return(input_df)

R/saveRDS.R

@@ -32,7 +32,7 @@ setMethod("saveRDS", "SpatialFeatureExperiment",
               else {
                   for (i in seq_len(nrow(imgData(object)))) {
                       img <- int_metadata(object)$imgData$data[[i]]
-                      if (is(img, "SpatRasterImage"))
+                      if (inherits(img, "SpatRasterImage"))
                           img <- new("PackedRasterImage", wrap(img))
                       int_metadata(object)$imgData$data[[i]] <- img
                   }
@@ -53,13 +53,13 @@ setMethod("unwrap", "SpatialFeatureExperiment",
           function(x) {
               for (i in seq_len(nrow(imgData(x)))) {
                   img <- int_metadata(x)$imgData$data[[i]]
-                  if (is(img, "PackedSpatRaster"))
+                  if (inherits(img, "PackedSpatRaster"))
                       img <- SpatRasterImage(unwrap(img))
-                  else if (is(img, "SpatRasterImage")) {
+                  else if (inherits(img, "SpatRasterImage")) {
                       old_slot <- tryCatch(img@image, error = function(e) NULL)
                       if (!is.null(old_slot)) {
-                          if (is(old_slot, "SpatRaster")) img <- old_slot
-                          if (is(old_slot, "PackedSpatRaster")) img <- unwrap(old_slot)
+                          if (inherits(old_slot, "SpatRaster")) img <- old_slot
+                          if (inherits(old_slot, "PackedSpatRaster")) img <- unwrap(old_slot)
                           img <- SpatRasterImage(img)
                       }
                   }

R/spatialGraphs.R

@@ -231,7 +231,7 @@ annotGraphs <- function(x, sample_id = "all", name = "all")
     if (type == "all") {
         if (is.null(value)) {
             df <- .initialize_spatialGraphs(x)
-        } else if (!is(value, "DataFrame")) {
+        } else if (!inherits(value, "DataFrame")) {
             value <- lapply(value, .fill_missing,
                 names_use = c("row", "col", "annot")
             )
@@ -425,7 +425,7 @@ annotGraph <- function(x, type = 1L, sample_id = 1L) {
 .sg_r <- function(x, type = 1L, MARGIN, sample_id = NULL, value) {
     sample_id <- .check_sample_id(x, sample_id)
     if (!is.null(value)) {
-        if (!is(value, "listw")) {
+        if (!inherits(value, "listw")) {
             stop("value must be of class listw.")
         } else if (MARGIN == 1L && length(value$neighbours) != nrow(x)) {
             stop(

R/utils.R

@@ -286,7 +286,7 @@ getTechTxFields <- function(tech, data_dir = NULL) {
             # NOTE: can take a while.
             mols <- .rawToChar_df(mols, BPPARAM = BPPARAM)
             # sanity, convert to data.table
-            if (!is(mols, "data.table")) {
+            if (!inherits(mols, "data.table")) {
                 mols <- data.table::as.data.table(mols)
             }
         } else {

R/validity.R

@@ -1,7 +1,7 @@
 # Validity of SFE object
 .check_geometries <- function(gs, name_show) {
     msgs <- lapply(seq_along(gs), function(i) {
-        if (!is(gs[[i]], "sf")) {
+        if (!inherits(gs[[i]], "sf")) {
             paste0(
                 "Item ", i, " in ", name_show, " is ", class(gs[[i]])[1],
                 " rather than sf.\n"
@@ -130,7 +130,7 @@
     if (is.null(sg)) {
         return(character(0))
     }
-    if (is(sg, "DataFrame")) {
+    if (inherits(sg, "DataFrame")) {
         if (!setequal(rownames(sg), c("row", "col", "annot"))) {
             return("Row names of spatialGraphs must be 'row', 'col', and 'annot'.\n")
         }