From 78a314baabd93fbc9f89798f7312c130cac3f036 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Thu, 13 Mar 2025 18:21:06 -0400 Subject: [PATCH 01/45] aggregateFeatures and aggregation changes - new: `aggregateFeatures()` gobject function - param harmonizations: - `spatial_info` -> `spat_info` in `calculateOverlap()` - `poly_info` -> `spat_info` in `overlapToMatrix()` - `feat_subset_ids` -> `feat_subset_values` in `calculateOverlap()` - `count_info_column` -> `feat_count_column` in `calculateOverlap()` and `overlapToMatrix()` - `aggr_function` -> `fun` in `overlapToMatrtix()` - Deprecated functions: - `calculateOverlapRaster()` - `overlapImageToMatrix()` --- NAMESPACE | 1 + R/aggregate.R | 357 ++++++++++++++++++++++++++++------ man/aggregateFeatures.Rd | 87 +++++++++ man/calculateOverlap.Rd | 37 ++-- man/calculateOverlapRaster.Rd | 17 +- man/overlapToMatrix.Rd | 35 +++- 6 files changed, 445 insertions(+), 89 deletions(-) create mode 100644 man/aggregateFeatures.Rd diff --git a/NAMESPACE b/NAMESPACE index 9d5aa92d..8aff0faf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,6 +26,7 @@ export(addNetworkLayout) export(addSpatialCentroidLocations) export(addSpatialCentroidLocationsLayer) export(add_img_array_alpha) +export(aggregateFeatures) export(aggregateStacks) export(aggregateStacksExpression) export(aggregateStacksLocations) diff --git a/R/aggregate.R b/R/aggregate.R index 56e06942..49e1f9b6 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -18,6 +18,138 @@ NULL ## calculate overlap between cellular structures and features #### +#' @name aggregateFeatures +#' @title Aggregate Spatial Features Covered by Polygon Geometries +#' @description +#' Aggregate features (either `feat_info` OR `image_names`) with +#' polygons (`spat_info`). Under the hood, this is performed in two steps: +#' +#' 1. Find the overlapped features via the lower-level generic +#' [calculateOverlap()] +#' 2. Summarize the overlapped features as a matrix via [overlapToMatrix()] +#' @param gobject `giotto` object containing spatial data to aggregate. +#' @param spat_info character. Name of polygon information to use to aggregate +#' features with. +#' @param feat_info character. Name of feature point detections to be +#' aggregated. +#' @param image_names character. Name of image(s) containing intensity values +#' to be aggregated. +#' @param spat_unit character (optional). Name of spatial unit to assign the +#' expression info to. Default is the same as `spat_info`. +#' @param feat_type character (optional). Name of feature type to assign the +#' expression info to. Default is the same as `feat_info` when used. When +#' `image_names` is used instead, default is "protein". +#' @param name character. (default = "raw") Name to assign the output +#' expresssion values information. +#' @param poly_subset_ids character vector. (optional) Specific poly_IDs to use +#' @param feat_subset_column character. (optional) feature info attribute to +#' subset feature points on when performing overlap calculation. +#' @param feat_subset_values (optional) values matched against +#' in `feat_subset_column` in order to subset feature points when performing +#' overlap calculation. +#' @param feat_count_column character. (optional) feature info column with counts +#' information. Useful in cases when more than one detection is reported per +#' point. +#' @param fun character (default = "sum"). Function to aggregate image +#' information +#' @param return_gobject logical (default = TRUE). Whether to return the +#' `giotto` object or just the aggregated expression values as `exprObj` class. +#' @param verbose logical. Whether to be verbose. +#' @param \dots Additional params to pass (none implemented) +#' @returns `giotto` when `return_gobject=TRUE`, `exprObj` when +#' `return_gobject=FALSE` +#' @details `feat_subset_column`, `feat_subset_values`, and `feat_count_column` +#' are specific to overlaps on feature points info, and should not be provided +#' when overlapping image data. +#' @export +aggregateFeatures <- function(gobject, + spat_info = NULL, + feat_info = NULL, + image_names = NULL, + spat_unit = NULL, + feat_type = NULL, + name = "raw", + poly_subset_ids = NULL, + feat_subset_column = NULL, + feat_subset_values = NULL, + feat_count_column = NULL, + fun = "sum", + return_gobject = TRUE, + verbose = TRUE, + ... +) { + checkmate::assert_character(spat_info, len = 1L, null.ok = TRUE) + checkmate::assert_character(feat_info, null.ok = TRUE) + checkmate::assert_character(image_names, null.ok = TRUE) + checkmate::assert_character(fun, len = 1L) + checkmate::assert_character(name, len = 1L) + checkmate::assert_logical(return_gobject) + checkmate::assert_character(feat_count_column, null.ok = TRUE) + + # catch improper feature input usage + fun_tag <- "[aggregateFeatures] " + if (!is.null(feat_info) && !is.null(image_names)) { + stop(fun_tag, "Only one of 'feat_info' or 'image_names' may ", + "be provided.\n", call. = FALSE) + } + + # decide polygons to use + spat_info <- spat_info %null% names(gobject@spatial_info)[[1]] + + # decide target spatial unit + spat_unit <- spat_unit %null% spat_info + # decide target feature type + if (is.null(feat_type)) { + if (!is.null(feat_info)) feat_type <- feat_info + if (!is.null(image_names)) feat_type <- "protein" + } + + # select overlapToMatrix type + o2m_type <- if (!is.null(feat_info)) { + "point" + } else if (!is.null(image_names)) { + "intensity" + } + + gobject <- calculateOverlap(gobject, + spat_info = spat_info, + feat_info = feat_info, + name_overlap = feat_type, + image_names = image_names, + poly_subset_ids = poly_subset_ids, + feat_subset_column = feat_subset_column, + feat_subset_values = feat_subset_values, + feat_count_column = feat_count_column, + return_gobject = TRUE, + verbose = verbose + ) + + ex <- overlapToMatrix(gobject, + name = name, + poly_info = spat_info, + feat_info = feat_type, + type = o2m_type, + feat_count_column = feat_count_column, + fun = fun, + return_gobject = FALSE, + verbose = verbose, + ... + ) + + # this is moved out since overlapToMatrix doesn't have a way to + # set the spat unit (if it doesn't match spat_info) + spatUnit(ex) <- spat_unit + + gobject <- setGiotto(gobject, ex, verbose = verbose) + return(gobject) +} + + + + + + + ### ** raster way #### #' @title Convert polygon to raster @@ -60,6 +192,9 @@ polygon_to_raster <- function(polygon, field = NULL) { } + + + # calculateOverlap methods #### @@ -76,15 +211,17 @@ polygon_to_raster <- function(polygon, field = NULL) { #' @param poly_subset_ids character vector. (optional) Specific poly_IDs to use #' @param feat_subset_column character. (optional) feature info attribute to #' subset feature points on when performing overlap calculation. -#' @param feat_subset_ids (optional) values matched against +#' @param feat_subset_values (optional) values matched against #' in `feat_subset_column` in order to subset feature points when performing #' overlap calculation. -#' @param count_info_column character. (optional) column with count information. +#' @param feat_subset_ids deprecated. Use `feat_subset_values` instead. +#' @param feat_count_column character. (optional) column with count information. #' Useful in cases when more than one detection is reported per point. #' @param verbose be verbose +#' @param count_info_column deprecated. Use `feat_count_column` instead. #' @param \dots additional params to pass to methods. -#' @details `feat_subset_column`, `feat_subset_ids`, and `count_info_column` are -#' specific to overlaps on feature points info, and should not be provided +#' @details `feat_subset_column`, `feat_subset_values`, and `feat_count_column` +#' are specific to overlaps on feature points info, and should not be provided #' when overlapping image data. These three params can also be passed to the #' `giotto` method through the `...` param when working with overlaps on feature #' points info. @@ -115,7 +252,7 @@ polygon_to_raster <- function(polygon, field = NULL) { #' # calculate z1 only #' out_z1 <- calculateOverlap(gpoly, gpoints, #' feat_subset_column = "global_z", -#' feat_subset_ids = c(1) +#' feat_subset_values = c(1) #' ) #' overlaps_z1 <- overlaps(out_z1) #' overlaps_z1$rna @@ -129,7 +266,7 @@ polygon_to_raster <- function(polygon, field = NULL) { #' # calculate z0 overlaps and return as gobject #' out_g <- calculateOverlap(g, #' feat_subset_column = "global_z", -#' feat_subset_ids = 0 +#' feat_subset_values = 0 #' ) #' overlaps(getPolygonInfo(out_g, return_giottoPolygon = TRUE)) #' @@ -151,13 +288,19 @@ setMethod( "calculateOverlap", signature(x = "giotto", y = "missing"), function(x, name_overlap = NULL, - spatial_info = NULL, + spat_info = NULL, feat_info = NULL, image_names = NULL, poly_subset_ids = NULL, return_gobject = TRUE, verbose = TRUE, + spatial_info = deprecated(), ...) { + # deprecations + spat_info <- GiottoUtils::deprecate_param(spatial_info, spat_info, + fun = "calculateOverlap", when = "0.4.7" + ) + # 0. guards # # --------- # @@ -213,8 +356,8 @@ setMethod( if (!is.null(image_names)) name_overlap <- "protein" } - if (is.null(spatial_info)) { - spatial_info <- names(x@spatial_info)[[1]] + if (is.null(spat_info)) { + spat_info <- names(x@spat_info)[[1]] } @@ -224,7 +367,7 @@ setMethod( # ---[polys to overlap with]--- A <- getPolygonInfo( gobject = x, - polygon_name = spatial_info, + polygon_name = spat_info, return_giottoPolygon = TRUE ) @@ -323,18 +466,30 @@ setMethod( name_overlap = NULL, poly_subset_ids = NULL, feat_subset_column = NULL, - feat_subset_ids = NULL, - count_info_column = NULL, + feat_subset_values = NULL, + feat_count_column = NULL, return_gpolygon = TRUE, verbose = TRUE, + feat_subset_ids = deprecated(), + count_info_column = deprecated(), ...) { + # deprecations + feat_subset_values <- GiottoUtils::deprecate_param( + feat_subset_ids, feat_subset_values, + fun = "calculateOverlap", when = "0.4.7" + ) + feat_count_column <- GiottoUtils::deprecate_param( + count_info_column, feat_count_column, + fun = "calculateOverlap", when = "0.4.7" + ) + res <- calculateOverlap( x = x[], y = y[], poly_subset_ids = poly_subset_ids, feat_subset_column = feat_subset_column, - feat_subset_ids = feat_subset_ids, - count_info_column = count_info_column, + feat_subset_values = feat_subset_values, + feat_count_column = feat_count_column, verbose = verbose, ... ) @@ -515,9 +670,20 @@ setMethod( function(x, y, poly_subset_ids = NULL, feat_subset_column = NULL, - feat_subset_ids = NULL, - count_info_column = NULL, - verbose = TRUE) { + feat_subset_values = NULL, + feat_count_column = NULL, + verbose = TRUE, + feat_subset_ids = deprecated(), + count_info_column = deprecated()) { + feat_subset_values <- GiottoUtils::deprecate_param( + feat_subset_ids, feat_subset_values, + fun = "calculateOverlap", when = "0.4.7" + ) + feat_count_column <- GiottoUtils::deprecate_param( + count_info_column, feat_count_column, + fun = "calculateOverlap", when = "0.4.7" + ) + checkmate::assert_true(terra::is.polygons(x)) checkmate::assert_true(terra::is.points(y)) # TODO allow another poly? if (!is.null(poly_subset_ids)) { @@ -532,15 +698,15 @@ setMethod( # * subset points if needed # e.g. to select transcripts within a z-plane - if (!is.null(feat_subset_column) && !is.null(feat_subset_ids)) { - bool_vector <- y[[feat_subset_column]][[1]] %in% feat_subset_ids + if (!is.null(feat_subset_column) && !is.null(feat_subset_values)) { + bool_vector <- y[[feat_subset_column]][[1]] %in% feat_subset_values y <- y[bool_vector] } .calculate_overlap_raster( spatvec = x, pointvec = y, - count_info_column = count_info_column, + count_info_column = feat_count_column, verbose = verbose ) } @@ -562,10 +728,13 @@ setMethod( #' @param poly_ID_names (optional) list of poly_IDs to use #' @param feat_info character. name of feature information #' @param feat_subset_column feature info column to subset features with -#' @param feat_subset_ids ids within feature info column to use for subsetting -#' @param count_info_column column with count information (optional) +#' @param feat_subset_values value(s) within feature info `feat_subset_column` +#' to use for subsetting +#' @param feat_count_column column with count information (optional) #' @param return_gobject return giotto object (default: TRUE) #' @param verbose be verbose +#' @param feat_subset_ids deprecated. Use `feat_subset_values` instead. +#' @param count_info_column deprecated. Use `feat_count_column` instead. #' @returns giotto object or spatVector with overlapping information #' @details Serial overlapping function. #' @concept overlap @@ -582,10 +751,28 @@ calculateOverlapRaster <- function( poly_ID_names = NULL, feat_info = NULL, feat_subset_column = NULL, - feat_subset_ids = NULL, - count_info_column = NULL, + feat_subset_values = NULL, + feat_count_column = NULL, return_gobject = TRUE, - verbose = TRUE) { + verbose = TRUE, + feat_subset_ids = deprecated(), + count_info_column = deprecated()) { + deprecate_warn( + when = "0.4.7", + what = "calculateOverlapRaster()", + with = "aggregateFeatures()", + details = "`calculateOverlap()` is another option if only the overlap + step is desired." + ) + feat_subset_values <- GiottoUtils::deprecate_param( + feat_subset_ids, feat_subset_values, + fun = "calculateOverlapRaster", when = "0.4.7" + ) + feat_count_column <- GiottoUtils::deprecate_param( + count_info_column, feat_count_column, + fun = "calculateOverlapRaster", when = "0.4.7" + ) + # set defaults if not provided if (is.null(feat_info)) { feat_info <- names(gobject@feat_info)[[1]] @@ -625,8 +812,9 @@ calculateOverlapRaster <- function( # * subset points if needed # e.g. to select transcripts within a z-plane - if (!is.null(feat_subset_column) & !is.null(feat_subset_ids)) { - bool_vector <- pointvec[[feat_subset_column]][[1]] %in% feat_subset_ids + if (!is.null(feat_subset_column) & !is.null(feat_subset_values)) { + bool_vector <- pointvec[[feat_subset_column]][[1]] %in% + feat_subset_values pointvec <- pointvec[bool_vector] } @@ -634,7 +822,7 @@ calculateOverlapRaster <- function( overlap_points <- .calculate_overlap_raster( spatvec = spatvec, pointvec = pointvec, - count_info_column = count_info_column, + count_info_column = feat_count_column, verbose = verbose ) @@ -1210,7 +1398,8 @@ calculateOverlapParallel <- function(gobject, #' @param x object containing overlaps info. Can be giotto object or SpatVector #' points or data.table of overlaps generated from `calculateOverlap` #' @param name name for the overlap count matrix -#' @param count_info_column column with count information +#' @param feat_count_column column with count information +#' @param count_info_column deprecated. Use `feat_count_column` instead. #' @param \dots additional params to pass to methods #' @concept overlap #' @returns giotto object or count matrix @@ -1231,55 +1420,70 @@ NULL # * gobject #### #' @rdname overlapToMatrix -#' @param poly_info character. Polygon information to use +#' @param spat_info character. Polygon information to use #' @param feat_info character. Feature information to use #' @param type character. Type of overlap data (either 'point' or 'intensity') #' @param return_gobject return giotto object (default: TRUE) #' @param verbose be verbose +#' @param poly_info deprecated. Please use spat_info. #' @export setMethod( "overlapToMatrix", signature("giotto"), function(x, name = "raw", - poly_info = NULL, + spat_info = NULL, feat_info = NULL, type = c("point", "intensity"), - count_info_column = NULL, - aggr_function = "sum", + feat_count_column = NULL, + fun = "sum", return_gobject = TRUE, verbose = TRUE, + aggr_function = deprecated(), + poly_info = deprecated(), + count_info_column = deprecated(), ...) { + # deprecations + spat_info <- GiottoUtils::deprecate_param(poly_info, spat_info, + fun = "overlapToMatrix", when = "0.4.7" + ) + feat_count_column <- GiottoUtils::deprecate_param( + count_info_column, feat_count_column, + fun = "overlapToMatrix", when = "0.4.7" + ) + fun <- GiottoUtils::deprecate_param(aggr_function, fun, + fun = "overlapToMatrix", when = "0.4.7" + ) + type <- match.arg(type, choices = c("point", "intensity")) checkmate::assert_character(name, len = 1L) - if (!is.null(count_info_column)) { - checkmate::assert_character(count_info_column, len = 1L) - } + checkmate::assert_character(feat_count_column, + len = 1L, null.ok = TRUE) checkmate::assert_logical(return_gobject) - poly_info <- set_default_spat_unit( + spat_info <- set_default_spat_unit( gobject = x, - spat_unit = poly_info + spat_unit = spat_info ) feat_info <- set_default_feat_type( gobject = x, - spat_unit = poly_info, + spat_unit = spat_info, feat_type = feat_info ) # get data gpoly <- getPolygonInfo( gobject = x, - polygon_name = poly_info, + polygon_name = spat_info, return_giottoPolygon = TRUE, verbose = verbose ) o2m_args <- list( x = gpoly, - col_names = spatIDs(x, spat_unit = poly_info), + col_names = spatIDs(x, spat_unit = spat_info), row_names = featIDs(x, feat_type = feat_info), feat_info = feat_info, - count_info_column = count_info_column, - aggr_function = aggr_function, + feat_count_column = feat_count_column, + fun = fun, # output = 'Matrix', # Do not specify here. methods must return # something that operates similarly to a [matrix] # object by default. @@ -1302,9 +1506,9 @@ setMethod( overlapExprObj <- create_expr_obj( name = name, exprMat = overlapmatrix, - spat_unit = poly_info, + spat_unit = spat_info, feat_type = feat_info, - provenance = poly_info + provenance = spat_info ) if (isTRUE(return_gobject)) { @@ -1320,8 +1524,8 @@ setMethod( spatlocs <- createSpatLocsObj( coordinates = centroidsDT_loc, name = name, - spat_unit = poly_info, - provenance = poly_info, + spat_unit = spat_info, + provenance = spat_info, verbose = FALSE ) @@ -1359,9 +1563,16 @@ setMethod( "overlapToMatrix", signature("giottoPolygon"), function(x, feat_info = "rna", type = c("point", "intensity"), - count_info_column = NULL, + feat_count_column = NULL, output = c("Matrix", "data.table"), + count_info_column = deprecated(), ...) { + # deprecations + feat_count_column <- GiottoUtils::deprecate_param( + count_info_column, feat_count_column, + fun = "overlapToMatrix", when = "0.4.7" + ) + type <- match.arg(type, choices = c("point", "intensity")) overlaps_data <- switch(type, @@ -1379,14 +1590,14 @@ setMethod( argslist <- list( x = overlaps_data, - count_info_column = count_info_column, + feat_count_column = feat_count_column, output = output, ... ) # remove args not accepted by specific method if (type == "intensity") { - argslist$count_info_column <- NULL + argslist$feat_count_column <- NULL argslist$col_names <- NULL argslist$row_names <- NULL argslist$verbose <- NULL @@ -1410,10 +1621,17 @@ setMethod( "overlapToMatrix", signature("SpatVector"), function(x, col_names = NULL, row_names = NULL, - count_info_column = NULL, + feat_count_column = NULL, output = c("Matrix", "data.table"), verbose = TRUE, + count_info_column = deprecated(), ...) { + # deprecations + feat_count_column <- GiottoUtils::deprecate_param( + count_info_column, feat_count_column, + fun = "overlapToMatrix", when = "0.4.7" + ) + output <- match.arg( toupper(output), choices = c("MATRIX", "DATA.TABLE") @@ -1429,20 +1647,20 @@ setMethod( # 2. Perform aggregation to counts DT - if (!is.null(count_info_column)) { # if there is a counts col + if (!is.null(feat_count_column)) { # if there is a counts col - if (!count_info_column %in% colnames(dtoverlap)) { - .gstop("count_info_column ", count_info_column, + if (!feat_count_column %in% colnames(dtoverlap)) { + .gstop("feat_count_column ", feat_count_column, " does not exist", .n = 2L ) } # aggregate counts of features - dtoverlap[, c(count_info_column) := as.numeric( - get(count_info_column) + dtoverlap[, c(feat_count_column) := as.numeric( + get(feat_count_column) )] - aggr_dtoverlap <- dtoverlap[, base::sum(get(count_info_column)), + aggr_dtoverlap <- dtoverlap[, base::sum(get(feat_count_column)), by = c("poly_ID", "feat_ID") ] data.table::setnames(aggr_dtoverlap, "V1", "N") @@ -1513,12 +1731,20 @@ setMethod( # * data.frame #### # images #' @rdname overlapToMatrix -#' @param aggr_function function to aggregate image information (default = sum) +#' @param fun character. Function to aggregate image information +#' (default = "sum") +#' @param aggr_function deprecated. Use `fun` instead. #' @export setMethod( "overlapToMatrix", signature("data.table"), function(x, - aggr_function = "sum", - output = c("Matrix", "data.table")) { + fun = "sum", + output = c("Matrix", "data.table"), + aggr_function = deprecated()) { + + fun <- GiottoUtils::deprecate_param(aggr_function, fun, + fun = "overlapToMatrix", when = "0.4.7" + ) + output <- match.arg( toupper(output), choices = c("MATRIX", "DATA.TABLE") @@ -1533,7 +1759,7 @@ setMethod( variable.name = "feat_ID" ) - aggr_fun <- get(aggr_function) + aggr_fun <- get(fun) aggr_comb <- melt_image_info[, aggr_fun(value), by = .(poly_ID, feat_ID) ] @@ -1710,6 +1936,15 @@ overlapImagesToMatrix <- function(gobject, image_names = NULL, spat_locs_name = "raw", return_gobject = TRUE) { + + deprecate_warn( + when = "0.4.7", + what = "overlapImagesToMatrix()", + with = "aggregateFeatures()", + details = "`overlapToMatrix()` is another option if only the matrix + construction from overlaps information step is desired." + ) + # data.table vars value <- poly_ID <- feat_ID <- x <- y <- NULL diff --git a/man/aggregateFeatures.Rd b/man/aggregateFeatures.Rd new file mode 100644 index 00000000..911d91f7 --- /dev/null +++ b/man/aggregateFeatures.Rd @@ -0,0 +1,87 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/aggregate.R +\name{aggregateFeatures} +\alias{aggregateFeatures} +\title{Aggregate Spatial Features Covered by Polygon Geometries} +\usage{ +aggregateFeatures( + gobject, + spat_info = NULL, + feat_info = NULL, + image_names = NULL, + spat_unit = NULL, + feat_type = NULL, + name = "raw", + poly_subset_ids = NULL, + feat_subset_column = NULL, + feat_subset_values = NULL, + feat_count_column = NULL, + fun = "sum", + return_gobject = TRUE, + verbose = TRUE, + ... +) +} +\arguments{ +\item{gobject}{\code{giotto} object containing spatial data to aggregate.} + +\item{spat_info}{character. Name of polygon information to use to aggregate +features with.} + +\item{feat_info}{character. Name of feature point detections to be +aggregated.} + +\item{image_names}{character. Name of image(s) containing intensity values +to be aggregated.} + +\item{spat_unit}{character (optional). Name of spatial unit to assign the +expression info to. Default is the same as \code{spat_info}.} + +\item{feat_type}{character (optional). Name of feature type to assign the +expression info to. Default is the same as \code{feat_info} when used. When +\code{image_names} is used instead, default is "protein".} + +\item{name}{character. (default = "raw") Name to assign the output +expresssion values information.} + +\item{poly_subset_ids}{character vector. (optional) Specific poly_IDs to use} + +\item{feat_subset_column}{character. (optional) feature info attribute to +subset feature points on when performing overlap calculation.} + +\item{feat_subset_values}{(optional) values matched against +in \code{feat_subset_column} in order to subset feature points when performing +overlap calculation.} + +\item{feat_count_column}{character. (optional) feature info column with counts +information. Useful in cases when more than one detection is reported per +point.} + +\item{fun}{character (default = "sum"). Function to aggregate image +information} + +\item{return_gobject}{logical (default = TRUE). Whether to return the +\code{giotto} object or just the aggregated expression values as \code{exprObj} class.} + +\item{verbose}{logical. Whether to be verbose.} + +\item{\dots}{Additional params to pass (none implemented)} +} +\value{ +\code{giotto} when \code{return_gobject=TRUE}, \code{exprObj} when +\code{return_gobject=FALSE} +} +\description{ +Aggregate features (either \code{feat_info} OR \code{image_names}) with +polygons (\code{spat_info}). Under the hood, this is performed in two steps: +\enumerate{ +\item Find the overlapped features via the lower-level generic +\code{\link[=calculateOverlap]{calculateOverlap()}} +\item Summarize the overlapped features as a matrix via \code{\link[=overlapToMatrix]{overlapToMatrix()}} +} +} +\details{ +\code{feat_subset_column}, \code{feat_subset_values}, and \code{feat_count_column} +are specific to overlaps on feature points info, and should not be provided +when overlapping image data. +} diff --git a/man/calculateOverlap.Rd b/man/calculateOverlap.Rd index f75ef50c..86796d0f 100644 --- a/man/calculateOverlap.Rd +++ b/man/calculateOverlap.Rd @@ -14,12 +14,13 @@ \S4method{calculateOverlap}{giotto,missing}( x, name_overlap = NULL, - spatial_info = NULL, + spat_info = NULL, feat_info = NULL, image_names = NULL, poly_subset_ids = NULL, return_gobject = TRUE, verbose = TRUE, + spatial_info = deprecated(), ... ) @@ -29,10 +30,12 @@ name_overlap = NULL, poly_subset_ids = NULL, feat_subset_column = NULL, - feat_subset_ids = NULL, - count_info_column = NULL, + feat_subset_values = NULL, + feat_count_column = NULL, return_gpolygon = TRUE, verbose = TRUE, + feat_subset_ids = deprecated(), + count_info_column = deprecated(), ... ) @@ -73,9 +76,11 @@ y, poly_subset_ids = NULL, feat_subset_column = NULL, - feat_subset_ids = NULL, - count_info_column = NULL, - verbose = TRUE + feat_subset_values = NULL, + feat_count_column = NULL, + verbose = TRUE, + feat_subset_ids = deprecated(), + count_info_column = deprecated() ) } \arguments{ @@ -85,8 +90,6 @@ polygons. Can also be a \code{giotto} object} \item{name_overlap}{name for the overlap results (default to feat_info parameter)} -\item{spatial_info}{character. Name polygon information} - \item{feat_info}{character. Name of vector feature information to overlap} \item{image_names}{character vector. Name(s) of the image feature information @@ -98,6 +101,8 @@ to overlap} \item{verbose}{be verbose} +\item{spatial_info}{character. Name polygon information} + \item{\dots}{additional params to pass to methods.} \item{y}{Object with features to overlap: \code{giottoPoints}, \code{giottoLargeImage}, @@ -106,16 +111,20 @@ to overlap} \item{feat_subset_column}{character. (optional) feature info attribute to subset feature points on when performing overlap calculation.} -\item{feat_subset_ids}{(optional) values matched against +\item{feat_subset_values}{(optional) values matched against in \code{feat_subset_column} in order to subset feature points when performing overlap calculation.} -\item{count_info_column}{character. (optional) column with count information. +\item{feat_count_column}{character. (optional) column with count information. Useful in cases when more than one detection is reported per point.} \item{return_gpolygon}{default = TRUE. Whether to return the entire giottoPolygon provided to \code{x}, but with the overlaps information appended or as a bare terra \code{SpatVector}} + +\item{feat_subset_ids}{deprecated. Use \code{feat_subset_values} instead.} + +\item{count_info_column}{deprecated. Use \code{feat_count_column} instead.} } \value{ Usually an object of the same class as \code{x}, with the overlaps @@ -129,8 +138,8 @@ polygon annotations. This provides a summary of the spatial data overlapped by the polygon which can be further processed to become an expression matrix. } \details{ -\code{feat_subset_column}, \code{feat_subset_ids}, and \code{count_info_column} are -specific to overlaps on feature points info, and should not be provided +\code{feat_subset_column}, \code{feat_subset_values}, and \code{feat_count_column} +are specific to overlaps on feature points info, and should not be provided when overlapping image data. These three params can also be passed to the \code{giotto} method through the \code{...} param when working with overlaps on feature points info. @@ -158,7 +167,7 @@ overlaps_all$rna # calculate z1 only out_z1 <- calculateOverlap(gpoly, gpoints, feat_subset_column = "global_z", - feat_subset_ids = c(1) + feat_subset_values = c(1) ) overlaps_z1 <- overlaps(out_z1) overlaps_z1$rna @@ -172,7 +181,7 @@ overlaps_img$intensity # calculate z0 overlaps and return as gobject out_g <- calculateOverlap(g, feat_subset_column = "global_z", - feat_subset_ids = 0 + feat_subset_values = 0 ) overlaps(getPolygonInfo(out_g, return_giottoPolygon = TRUE)) diff --git a/man/calculateOverlapRaster.Rd b/man/calculateOverlapRaster.Rd index 7db26aed..476f27ea 100644 --- a/man/calculateOverlapRaster.Rd +++ b/man/calculateOverlapRaster.Rd @@ -11,10 +11,12 @@ calculateOverlapRaster( poly_ID_names = NULL, feat_info = NULL, feat_subset_column = NULL, - feat_subset_ids = NULL, - count_info_column = NULL, + feat_subset_values = NULL, + feat_count_column = NULL, return_gobject = TRUE, - verbose = TRUE + verbose = TRUE, + feat_subset_ids = deprecated(), + count_info_column = deprecated() ) } \arguments{ @@ -31,13 +33,18 @@ results (default to feat_info parameter)} \item{feat_subset_column}{feature info column to subset features with} -\item{feat_subset_ids}{ids within feature info column to use for subsetting} +\item{feat_subset_values}{value(s) within feature info \code{feat_subset_column} +to use for subsetting} -\item{count_info_column}{column with count information (optional)} +\item{feat_count_column}{column with count information (optional)} \item{return_gobject}{return giotto object (default: TRUE)} \item{verbose}{be verbose} + +\item{feat_subset_ids}{deprecated. Use \code{feat_subset_values} instead.} + +\item{count_info_column}{deprecated. Use \code{feat_count_column} instead.} } \value{ giotto object or spatVector with overlapping information diff --git a/man/overlapToMatrix.Rd b/man/overlapToMatrix.Rd index 0dd9db93..da03b349 100644 --- a/man/overlapToMatrix.Rd +++ b/man/overlapToMatrix.Rd @@ -11,13 +11,16 @@ \S4method{overlapToMatrix}{giotto}( x, name = "raw", - poly_info = NULL, + spat_info = NULL, feat_info = NULL, type = c("point", "intensity"), - count_info_column = NULL, - aggr_function = "sum", + feat_count_column = NULL, + fun = "sum", return_gobject = TRUE, verbose = TRUE, + aggr_function = deprecated(), + poly_info = deprecated(), + count_info_column = deprecated(), ... ) @@ -25,8 +28,9 @@ x, feat_info = "rna", type = c("point", "intensity"), - count_info_column = NULL, + feat_count_column = NULL, output = c("Matrix", "data.table"), + count_info_column = deprecated(), ... ) @@ -34,13 +38,19 @@ x, col_names = NULL, row_names = NULL, - count_info_column = NULL, + feat_count_column = NULL, output = c("Matrix", "data.table"), verbose = TRUE, + count_info_column = deprecated(), ... ) -\S4method{overlapToMatrix}{data.table}(x, aggr_function = "sum", output = c("Matrix", "data.table")) +\S4method{overlapToMatrix}{data.table}( + x, + fun = "sum", + output = c("Matrix", "data.table"), + aggr_function = deprecated() +) } \arguments{ \item{x}{object containing overlaps info. Can be giotto object or SpatVector @@ -48,20 +58,27 @@ points or data.table of overlaps generated from \code{calculateOverlap}} \item{name}{name for the overlap count matrix} -\item{poly_info}{character. Polygon information to use} +\item{spat_info}{character. Polygon information to use} \item{feat_info}{character. Feature information to use} \item{type}{character. Type of overlap data (either 'point' or 'intensity')} -\item{count_info_column}{column with count information} +\item{feat_count_column}{column with count information} -\item{aggr_function}{function to aggregate image information (default = sum)} +\item{fun}{character. Function to aggregate image information +(default = "sum")} \item{return_gobject}{return giotto object (default: TRUE)} \item{verbose}{be verbose} +\item{aggr_function}{deprecated. Use \code{fun} instead.} + +\item{poly_info}{deprecated. Please use spat_info.} + +\item{count_info_column}{deprecated. Use \code{feat_count_column} instead.} + \item{\dots}{additional params to pass to methods} \item{output}{data format/class to return the results as} From 21f2f78a63288d1db8540832d082bedadd5f2181 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Thu, 3 Apr 2025 18:48:07 -0400 Subject: [PATCH 02/45] enh: improve exprObj show() methods --- R/methods-show.R | 6 ++++-- R/slot_show.R | 18 ++++++++++++++---- 2 files changed, 18 insertions(+), 6 deletions(-) diff --git a/R/methods-show.R b/R/methods-show.R index fffe5e5b..9e276c37 100644 --- a/R/methods-show.R +++ b/R/methods-show.R @@ -217,7 +217,7 @@ setMethod( )] %none% print_cap writeLines(gsub( - pattern = "in show(.*?))'", replacement = "", + pattern = "in show().*", replacement = "", x = print_cap )) cat("\n First four colnames:") @@ -228,7 +228,9 @@ setMethod( ), "\n" ) } else if (inherits(slot(object, "exprMat"), "denseMatrix")) { - .abbrev_mat(object, nrows = 10, ncols = 10, header = FALSE) + .abbrev_mat(object, + nrows = 10, ncols = 6, print_prov = FALSE, header = FALSE + ) } else { # * other matrices * print(slot(object, "exprMat")) diff --git a/R/slot_show.R b/R/slot_show.R index 3f223a36..b104c871 100644 --- a/R/slot_show.R +++ b/R/slot_show.R @@ -1110,17 +1110,21 @@ showGiottoImageNames <- function(gobject) { #' matrix, data.frame and classes that inherit them. #' @keywords internal #' @returns abbreviated matrix exprObj -.abbrev_mat <- function(exprObj, nrows, ncols, header = TRUE) { - mat <- as.matrix(exprObj[]) +.abbrev_mat <- function(exprObj, nrows, ncols, + print_prov = TRUE, header = TRUE +) { + mat <- exprObj[] four_names <- head(colnames(mat), 4) mat_cols <- ncol(mat) mat_rows <- nrow(mat) # suppress colnames + cols_suppressed <- mat_cols > ncols mat <- mat[ seq_len(if (nrows <= mat_rows) nrows else mat_rows), seq_len(if (ncols <= mat_cols) ncols else mat_cols) ] + mat <- as.matrix(mat) colnames(mat) <- NULL # prints @@ -1131,7 +1135,7 @@ showGiottoImageNames <- function(gobject) { '" and feature type: "', exprObj@feat_type, '"\n' )) } - cat(" Provenance:", exprObj@provenance) + if (isTRUE(print_prov)) cat(" Provenance:", exprObj@provenance) if (isTRUE(header)) { cat("\n\ncontains:\n") } else { @@ -1141,7 +1145,13 @@ showGiottoImageNames <- function(gobject) { mat_rows, " x ", mat_cols, ' dense matrix of class "', class(exprObj[]), '"\n\n' )) - print(mat) + output <- capture.output(print(mat)) + if (cols_suppressed) { + output <- paste(output, "......") + } + for (i in seq(from = 2, to = length(output))) { + cat(output[i], "\n") + } cat("\n First four colnames:") cat("\n", wrap_txt(four_names, strWidth = 40), "\n") } From 44cb00401288734a966989687c186af962aaf737 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Sun, 6 Apr 2025 21:57:53 -0400 Subject: [PATCH 03/45] fix: revert to previous flip handling for images --- R/methods-flip.R | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/R/methods-flip.R b/R/methods-flip.R index 3e2441f4..60187b72 100644 --- a/R/methods-flip.R +++ b/R/methods-flip.R @@ -147,12 +147,11 @@ setMethod( # TODO apply as instructions for lazy eval after crop/resampling #' @rdname flip #' @export -setMethod( - "flip", signature(x = "giottoLargeImage"), - function(x, direction = "vertical", x0 = 0, y0 = 0, ...) { - .flip_large_image(image = x, direction = direction, x0 = x0, y0 = y0) - } -) +setMethod("flip", signature("giottoLargeImage"), function(x, direction = "vertical", x0 = 0, y0 = 0) { + a <- get_args_list() + a$x <- as(x, "giottoAffineImage") # convert to giottoAffineImage + do.call(flip, args = a) +}) #' @rdname flip #' @export From 87ee8ba288f905e3a7b054d0166dde40a6f8bda3 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Sun, 6 Apr 2025 22:20:58 -0400 Subject: [PATCH 04/45] chore: remove unused flip image internal --- R/methods-flip.R | 49 ------------------------------------------------ 1 file changed, 49 deletions(-) diff --git a/R/methods-flip.R b/R/methods-flip.R index 60187b72..78e2ff90 100644 --- a/R/methods-flip.R +++ b/R/methods-flip.R @@ -353,55 +353,6 @@ setMethod("flip", signature("affine2d"), function(x, direction = "vertical", x0 } - - -#' @name .flip_large_image -#' @title Flip a giottoLargeImage object -#' @param image giottoLargeImage -#' @param direction character. Direction to flip. Should be either partial -#' match to 'vertical' or 'horizontal' -#' @param x0 x value to flip horizontally over (ignored for vertical). Pass NULL -#' to flip over the extent -#' @param y0 y value to flip vertically over (ignored for horizontal). Pass NULL -#' to flip over the extent -#' @keywords internal -#' @noRd -.flip_large_image <- function(image, - direction = "vertical", - x0 = 0, - y0 = 0) { - checkmate::assert_class(image, "giottoLargeImage") - checkmate::assert_character(direction) - if (!is.null(x0)) { - checkmate::assert_numeric(x0) - } - if (!is.null(y0)) { - checkmate::assert_numeric(y0) - } - - # 1. perform flip - e <- ext(image) - image@raster_object <- terra::flip(image@raster_object, - direction = direction - ) - - # 2. perform shift to match line of symmetry - if (grepl(direction, "vertical") & !is.null(y0)) { - y_range <- as.numeric(c(e$ymin, e$ymax)) - dy <- 2 * y0 - y_range[1] - y_range[2] - image <- spatShift(x = image, dy = dy) - } - if (grepl(direction, "horizontal") & !is.null(x0)) { - x_range <- as.numeric(c(e$xmin, e$xmax)) - dx <- 2 * x0 - x_range[1] - x_range[2] - image <- spatShift(x = image, dx = dx) - } - - # 3. return - return(image) -} - - #' @name .flip_gpoints #' @title Flip a giottoPoints object #' @description Flip a giottoPoints over a designated x or y value depending on From 749c7b6a187bd2e49b183c9b2318cef583f3278b Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Thu, 24 Apr 2025 12:28:24 -0400 Subject: [PATCH 05/45] enh: tif tool updates also should support qptiff --- NAMESPACE | 2 + R/globals.R | 2 +- R/images.R | 188 +++++++++++++++--- .../{ometif_convert.py => tif_convert.py} | 8 +- man/ometif_metadata.Rd | 38 ---- man/tif_metadata.Rd | 78 ++++++++ man/{ometif_to_tif.Rd => to_simple_tif.Rd} | 33 ++- 7 files changed, 266 insertions(+), 83 deletions(-) rename inst/python/{ometif_convert.py => tif_convert.py} (63%) delete mode 100644 man/ometif_metadata.Rd create mode 100644 man/tif_metadata.Rd rename man/{ometif_to_tif.Rd => to_simple_tif.Rd} (51%) diff --git a/NAMESPACE b/NAMESPACE index 8aff0faf..55aa9533 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -268,6 +268,8 @@ export(subsetGiottoLocsSubcellular) export(svkey) export(t_flex) export(tessellate) +export(tif_metadata) +export(to_simple_tif) export(triGrid) export(updateGiottoImage) export(updateGiottoImageMG) diff --git a/R/globals.R b/R/globals.R index 4b69b0be..f8adeac2 100644 --- a/R/globals.R +++ b/R/globals.R @@ -19,7 +19,7 @@ globalVariables( "extract_NN_info", "align_network_data", "extract_SN_connectivities", "extract_SN_distances", "set_adg_sn", "create_AnnData", # tifffile - "ometif_2_tif", + "py_tif_convert", # spatialdata interop "createSpatialData", "read_spatialdata_from_path", "extract_spatial", "extract_image" diff --git a/R/images.R b/R/images.R index b81eb736..43f8b8b4 100644 --- a/R/images.R +++ b/R/images.R @@ -2775,23 +2775,25 @@ setMethod( # converters #### -#' @title Convert ome.tif to tif -#' @name ometif_to_tif +#' @title Convert Specialized TIF Formats to Basic TIF +#' @name to_simple_tif #' @description -#' Simple converter from .ome.tif to .tif format. Utilizes the python +#' Simple converter from specialized formats to .tif format. Utilizes the python #' \pkg{tifffile} package. Performs image conversions one page at a time. -#' Wrap this in a for loop or lapply for more than one image or page. -#' @param input_file character. Filepath to ome.tif to convert +#' Wrap this in a for loop or lapply for more than one image or page. Used +#' when image formats are unsupported by terra. This is implementation may +#' change in the future. Currently tested to work with `.ome.tif` and `qptiff` +#' @param input_file character. Filepath to tif to convert #' @param output_dir character. Directory to write .tif to. Defaults to a new -#' folder in the directory called "tif_exports" +#' folder in the directory called `"tif_exports"` #' @param page numeric. Which page of the tif to open (if needed). If provided, #' a "_%04d" formatted suffix will be added to the output filename. #' @param overwrite logical. Default = FALSE. Whether to overwrite if the #' filename already exists. #' @returns returns the written filepath invisibly -#' @family ometif utility functions +#' @family tif utility functions #' @export -ometif_to_tif <- function(input_file, +to_simple_tif <- function(input_file, output_dir = file.path(dirname(input_file), "tif_exports"), page, overwrite = FALSE) { @@ -2803,11 +2805,11 @@ ometif_to_tif <- function(input_file, repository = c("pip:tifffile", "pip:imagecodecs") ) - ometif2tif_path <- system.file( - "python", "ometif_convert.py", + py_tif_convert_path <- system.file( + "python", "tif_convert.py", package = "GiottoClass" ) - reticulate::source_python(ometif2tif_path) + reticulate::source_python(py_tif_convert_path) # ensure output directory exists if (!checkmate::test_directory_exists(output_dir)) { dir.create(output_dir, recursive = TRUE) @@ -2823,9 +2825,17 @@ ometif_to_tif <- function(input_file, } a$page <- a$page - 1L # zero indexed + fext_pattern <- ".ome.tif$" # default + if (all(c("ome", "tif") %in% file_extension(input_file))) { + fext_pattern <- ".ome.tif$" + } + if ("qptiff" %in% file_extension(input_file)) { + fext_pattern <- ".qptiff$" + } + # decide output filename fname <- sub( - pattern = ".ome.tif$", replacement = "", + pattern = fext_pattern, replacement = "", x = basename(input_file) ) fpath <- file.path( @@ -2843,31 +2853,60 @@ ometif_to_tif <- function(input_file, ) } } - do.call(ometif_2_tif, args = a) + do.call(py_tif_convert, args = a) return(invisible(fpath)) } +#' @describeIn to_simple_tif deprecated. +#' @export +ometif_to_tif <- to_simple_tif + -#' @name ometif_metadata -#' @title Read metadata of an ometif +#' @name tif_metadata +#' @title Read Metadata of a Specialized tif #' @description Use the python package tifffile to get the the XML metadata -#' of a .ome.tif file. The R package xml2 is then used to work with it to +#' of a .tif file. The R package {xml2} is then used to work with it to #' retrieve specific nodes in the xml data and extract data. -#' @param path character. filepath to .ome.tif image +#' @param path character. filepath to tif image #' @param node character vector. Specific xml node to get. More terms can be #' added to get a node from a specific hierarchy. +#' @param page numeric. Specific page to get metadata from. Currently only used +#' for `.qptiff`. +#' @param type character. Type of data to extract. Only affects +#' `output = data.frame` (Matches to one of "attribute", "text", "double", +#' "integer"). `output = "structure"` can help +#' with figuring out which is most appropriate. #' @param output character. One of "data.frame" to return a data.frame of the -#' attributes information of the xml node, "xmL" for an xml2 representation +#' attributes information of the xml node, "xmL" for an {xml2} representation #' of the node, "list" for an R native list (note that many items in the #' list may have overlapping names that make indexing difficult), or #' "structure" to invisibly return NULL, but print the structure of the XML #' document or node. #' @returns list of image metadata information -#' @family ometif utility functions +#' @examples +#' if (FALSE) { +#' # check structure of metadata +#' tif_metadata("path/to/ometif", output = "structure") +#' +#' # xenium morphology ometif - find channels/biomarkers +#' tif_metadata("path/to/ometif", node = "Channel") +#' +#' # phenocycler qptiff - find channels/biomarkers +#' tif_metadata("path/to/qptiff", +#' page = NULL, +#' node = "Biomarker", +#' type = "text" +#' ) +#' } +#' @family tif utility functions #' @export -ometif_metadata <- function(path, node = NULL, output = c("data.frame", "xml", "list", "structure")) { +tif_metadata <- function(path, + node = NULL, + page = NULL, + type = c("attribute", "text", "double", "integer"), + output = c("data.frame", "xml", "list", "structure")) { checkmate::assert_file_exists(path) package_check( pkg_name = c("tifffile", "xml2"), @@ -2876,26 +2915,112 @@ ometif_metadata <- function(path, node = NULL, output = c("data.frame", "xml", " TIF <- reticulate::import("tifffile", convert = TRUE, delay_load = TRUE) img <- TIF$TiffFile(path) - output <- match.arg( - output, + output <- match.arg(output, choices = c("data.frame", "xml", "list", "structure") ) - x <- xml2::read_xml(img$ome_metadata) + type <- match.arg(type, + choices = c("attribute", "text", "double", "integer") + ) + + .tif_metadata_extract( + img = img, + node = node, + page = page, + type = type, + output = output + ) +} + +#' @describeIn tif_metadata deprecated. +#' @export +ometif_metadata <- tif_metadata + + +.tif_metadata_extract <- function(img, node, page = NULL, type, output) { + npages <- length(img$series[[1L]]$pages) + if (is.null(page)) page <- seq_len(npages) + # ensure pages are in subscript bounds + if (any(page > npages)) { + oob_bool <- page > npages + oob_pages <- page[oob_bool] + warning( + sprintf("pages %s do not exist", + paste(collapse = ", ", oob_pages) + ), call. = FALSE + ) + page <- page[!oob_bool] + } + # if multiple pages, lapply recurse + if (length(page) > 1L && img$is_qpi) { + reslist <- lapply(page, function(p) { + data <- .tif_metadata_extract( + img = img, + node = node, + page = p, + type = type, + output = output + ) + }) + if (inherits(reslist[[1]], "data.frame")) { + reslist <- Reduce(rbind, reslist) + } + return(reslist) + } + + + + if (img$is_ome) x <- img$ome_metadata + else if (img$is_fluoview) x <- img$fluoview_metadata + else if (img$is_nih) x <- img$nih_metadata + else if (img$is_astrotiff) x <- img$astrotiff_metadata + else if (img$is_imagej) x <- img$imagej_metadata + else if (img$is_lsm) x <- img$lsm_metadata + else if (img$is_qpi) x <- img$series[[1]]$pages[[page - 1L]]$description + else if (img$is_micromanager) x <- img$micromanager_metadata + else stop("unrecognized tif format\n", call. = FALSE) + + x <- xml2::read_xml(x) + ns <- xml2::xml_ns(x) + has_namespace <- length(ns) > 0L if (!is.null(node)) { node <- paste(node, collapse = "/") - x <- xml2::xml_find_all( - x, sprintf("//d1:%s", node), - ns = xml2::xml_ns(x) - ) + if (has_namespace) { + x <- xml2::xml_find_all( + x, sprintf("//d1:%s", node), + ns = xml2::xml_ns(x) + ) + } else { + x <- xml2::xml_find_all( + x, sprintf("//%s", node) + ) + } } switch(output, "data.frame" = { - x <- Reduce("rbind", xml2::xml_attrs(x)) - rownames(x) <- NULL - x <- as.data.frame(x) - return(x) + switch(type, + "attribute" = { + x <- Reduce("rbind", xml2::xml_attrs(x)) + rownames(x) <- NULL + return(as.data.frame(x)) + }, + "text" = { + x <- (as.data.frame(xml2::xml_text(x))) + colnames(x) <- node + return(x) + }, + "double" = { + x <- (as.data.frame(xml2::xml_double(x))) + colnames(x) <- node + return(x) + }, + "integer" = { + x <- (as.data.frame(xml2::xml_integer(x))) + colnames(x) <- node + return(x) + } + ) }, "xml" = return(x), "list" = return(xml2::as_list(x)), @@ -2905,3 +3030,4 @@ ometif_metadata <- function(path, node = NULL, output = c("data.frame", "xml", " } ) } + diff --git a/inst/python/ometif_convert.py b/inst/python/tif_convert.py similarity index 63% rename from inst/python/ometif_convert.py rename to inst/python/tif_convert.py index 6bd21564..a5dc8f55 100644 --- a/inst/python/ometif_convert.py +++ b/inst/python/tif_convert.py @@ -1,14 +1,14 @@ import tifffile import os -def ometif_2_tif(input_file, output_file, page=None): +def py_tif_convert(input_file, output_file, page=None): - with tifffile.TiffFile(input_file) as ome_tif: + with tifffile.TiffFile(input_file) as input_tif: # Write the image data to the output file with tifffile.TiffWriter(output_file, bigtiff=True) as tif_writer: - if 0 <= page < len(ome_tif.pages): - ome_page = ome_tif.pages[page] + if 0 <= page < len(input_tif.pages): + ome_page = input_tif.pages[page] image_data = ome_page.asarray() tif_writer.write(image_data, contiguous=False) else: diff --git a/man/ometif_metadata.Rd b/man/ometif_metadata.Rd deleted file mode 100644 index d2077c2f..00000000 --- a/man/ometif_metadata.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/images.R -\name{ometif_metadata} -\alias{ometif_metadata} -\title{Read metadata of an ometif} -\usage{ -ometif_metadata( - path, - node = NULL, - output = c("data.frame", "xml", "list", "structure") -) -} -\arguments{ -\item{path}{character. filepath to .ome.tif image} - -\item{node}{character vector. Specific xml node to get. More terms can be -added to get a node from a specific hierarchy.} - -\item{output}{character. One of "data.frame" to return a data.frame of the -attributes information of the xml node, "xmL" for an xml2 representation -of the node, "list" for an R native list (note that many items in the -list may have overlapping names that make indexing difficult), or -"structure" to invisibly return NULL, but print the structure of the XML -document or node.} -} -\value{ -list of image metadata information -} -\description{ -Use the python package tifffile to get the the XML metadata -of a .ome.tif file. The R package xml2 is then used to work with it to -retrieve specific nodes in the xml data and extract data. -} -\seealso{ -Other ometif utility functions: -\code{\link{ometif_to_tif}()} -} -\concept{ometif utility functions} diff --git a/man/tif_metadata.Rd b/man/tif_metadata.Rd new file mode 100644 index 00000000..1cfcfd3c --- /dev/null +++ b/man/tif_metadata.Rd @@ -0,0 +1,78 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/images.R +\name{tif_metadata} +\alias{tif_metadata} +\alias{ometif_metadata} +\title{Read Metadata of a Specialized tif} +\usage{ +tif_metadata( + path, + node = NULL, + page = NULL, + type = c("attribute", "text", "double", "integer"), + output = c("data.frame", "xml", "list", "structure") +) + +ometif_metadata( + path, + node = NULL, + page = NULL, + type = c("attribute", "text", "double", "integer"), + output = c("data.frame", "xml", "list", "structure") +) +} +\arguments{ +\item{path}{character. filepath to tif image} + +\item{node}{character vector. Specific xml node to get. More terms can be +added to get a node from a specific hierarchy.} + +\item{page}{numeric. Specific page to get metadata from. Currently only used +for \code{.qptiff}.} + +\item{type}{character. Type of data to extract. Only affects +\code{output = data.frame} (Matches to one of "attribute", "text", "double", +"integer"). \code{output = "structure"} can help +with figuring out which is most appropriate.} + +\item{output}{character. One of "data.frame" to return a data.frame of the +attributes information of the xml node, "xmL" for an {xml2} representation +of the node, "list" for an R native list (note that many items in the +list may have overlapping names that make indexing difficult), or +"structure" to invisibly return NULL, but print the structure of the XML +document or node.} +} +\value{ +list of image metadata information +} +\description{ +Use the python package tifffile to get the the XML metadata +of a .tif file. The R package {xml2} is then used to work with it to +retrieve specific nodes in the xml data and extract data. +} +\section{Functions}{ +\itemize{ +\item \code{ometif_metadata()}: deprecated. + +}} +\examples{ +if (FALSE) { +# check structure of metadata +tif_metadata("path/to/ometif", output = "structure") + +# xenium morphology ometif - find channels/biomarkers +tif_metadata("path/to/ometif", node = "Channel") + +# phenocycler qptiff - find channels/biomarkers +tif_metadata("path/to/qptiff", + page = NULL, + node = "Biomarker", + type = "text" +) +} +} +\seealso{ +Other tif utility functions: +\code{\link{to_simple_tif}()} +} +\concept{tif utility functions} diff --git a/man/ometif_to_tif.Rd b/man/to_simple_tif.Rd similarity index 51% rename from man/ometif_to_tif.Rd rename to man/to_simple_tif.Rd index f9c6cc57..4d312ddf 100644 --- a/man/ometif_to_tif.Rd +++ b/man/to_simple_tif.Rd @@ -1,9 +1,17 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/images.R -\name{ometif_to_tif} +\name{to_simple_tif} +\alias{to_simple_tif} \alias{ometif_to_tif} -\title{Convert ome.tif to tif} +\title{Convert Specialized TIF Formats to Basic TIF} \usage{ +to_simple_tif( + input_file, + output_dir = file.path(dirname(input_file), "tif_exports"), + page, + overwrite = FALSE +) + ometif_to_tif( input_file, output_dir = file.path(dirname(input_file), "tif_exports"), @@ -12,10 +20,10 @@ ometif_to_tif( ) } \arguments{ -\item{input_file}{character. Filepath to ome.tif to convert} +\item{input_file}{character. Filepath to tif to convert} \item{output_dir}{character. Directory to write .tif to. Defaults to a new -folder in the directory called "tif_exports"} +folder in the directory called \code{"tif_exports"}} \item{page}{numeric. Which page of the tif to open (if needed). If provided, a "_\%04d" formatted suffix will be added to the output filename.} @@ -27,12 +35,19 @@ filename already exists.} returns the written filepath invisibly } \description{ -Simple converter from .ome.tif to .tif format. Utilizes the python +Simple converter from specialized formats to .tif format. Utilizes the python \pkg{tifffile} package. Performs image conversions one page at a time. -Wrap this in a for loop or lapply for more than one image or page. +Wrap this in a for loop or lapply for more than one image or page. Used +when image formats are unsupported by terra. This is implementation may +change in the future. Currently tested to work with \code{.ome.tif} and \code{qptiff} } +\section{Functions}{ +\itemize{ +\item \code{ometif_to_tif()}: deprecated. + +}} \seealso{ -Other ometif utility functions: -\code{\link{ometif_metadata}()} +Other tif utility functions: +\code{\link{tif_metadata}()} } -\concept{ometif utility functions} +\concept{tif utility functions} From a7aee3174f374e0abd1e92d334728b1da67378e2 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Wed, 30 Apr 2025 17:41:30 -0400 Subject: [PATCH 06/45] feat: aggregation changes --- DESCRIPTION | 2 +- NEWS.md | 12 + R/aggregate.R | 406 ++++++++++++++++++++++---------- R/classes.R | 120 +++++++++- R/giotto_structures.R | 1 + R/methods-coerce.R | 49 +++- R/methods-crop.R | 8 +- R/methods-extract.R | 285 +++++++++++++++++++++- R/methods-initialize.R | 3 +- R/methods-overlaps.R | 5 +- R/methods-show.R | 19 +- R/subset.R | 77 +++--- tests/testthat/test-aggregate.R | 217 +++++++++++++++++ 13 files changed, 1013 insertions(+), 191 deletions(-) create mode 100644 tests/testthat/test-aggregate.R diff --git a/DESCRIPTION b/DESCRIPTION index fa5d8662..514832bf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: GiottoClass Title: Giotto Suite Object Definitions and Framework -Version: 0.4.7 +Version: 0.5.0 Authors@R: c( person("Ruben", "Dries", email = "rubendries@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7650-7754")), diff --git a/NEWS.md b/NEWS.md index 5c4e11e4..21a042b7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,15 @@ +# GiottoClass 0.5.0 + +## changes +- `calculateOverlap()` and `overlapToMatrix()` param harmonization + +## new +- `aggregateFeatures()` wrapper for running `calculateOverlap()` and `overlapToMatrix()` +- `overlapPointDT()` and `overlapIntensityDT()` classes to store overlaps relationships efficiently and help with aggregation pipeline + +## bug fixes +- `overlaps()` will now properly find image overlaps + # GiottoClass 0.4.7 (2025/02/04) ## new diff --git a/R/aggregate.R b/R/aggregate.R index 49e1f9b6..d69fce2e 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -34,10 +34,10 @@ NULL #' aggregated. #' @param image_names character. Name of image(s) containing intensity values #' to be aggregated. -#' @param spat_unit character (optional). Name of spatial unit to assign the -#' expression info to. Default is the same as `spat_info`. -#' @param feat_type character (optional). Name of feature type to assign the -#' expression info to. Default is the same as `feat_info` when used. When +#' @param new_spat_unit character (optional). Name of spatial unit to assign +#' the expression info to. Default is the same as `spat_info`. +#' @param new_feat_type character (optional). Name of feature type to assign +#' the expression info to. Default is the same as `feat_info` when used. When #' `image_names` is used instead, default is "protein". #' @param name character. (default = "raw") Name to assign the output #' expresssion values information. @@ -50,12 +50,15 @@ NULL #' @param feat_count_column character. (optional) feature info column with counts #' information. Useful in cases when more than one detection is reported per #' point. -#' @param fun character (default = "sum"). Function to aggregate image -#' information +#' @param fun character (default = "sum"). A function usable by +#' [exactextractr::exact_extract()] to aggregate image intensity values. #' @param return_gobject logical (default = TRUE). Whether to return the #' `giotto` object or just the aggregated expression values as `exprObj` class. #' @param verbose logical. Whether to be verbose. -#' @param \dots Additional params to pass (none implemented) +#' @param \dots Additional params to pass to the overlap calculation method. +#' None implemented for point overlaps. For intensity overlaps, passes to +#' [exactextractr::exact_extract()] and additionally the function requested +#' with the `fun` param. #' @returns `giotto` when `return_gobject=TRUE`, `exprObj` when #' `return_gobject=FALSE` #' @details `feat_subset_column`, `feat_subset_values`, and `feat_count_column` @@ -66,8 +69,8 @@ aggregateFeatures <- function(gobject, spat_info = NULL, feat_info = NULL, image_names = NULL, - spat_unit = NULL, - feat_type = NULL, + new_spat_unit = NULL, + new_feat_type = NULL, name = "raw", poly_subset_ids = NULL, feat_subset_column = NULL, @@ -80,6 +83,8 @@ aggregateFeatures <- function(gobject, ) { checkmate::assert_character(spat_info, len = 1L, null.ok = TRUE) checkmate::assert_character(feat_info, null.ok = TRUE) + checkmate::assert_character(new_spat_unit, len = 1L, null.ok = TRUE) + checkmate::assert_character(new_feat_type, len = 1L, null.ok = TRUE) checkmate::assert_character(image_names, null.ok = TRUE) checkmate::assert_character(fun, len = 1L) checkmate::assert_character(name, len = 1L) @@ -97,48 +102,83 @@ aggregateFeatures <- function(gobject, spat_info <- spat_info %null% names(gobject@spatial_info)[[1]] # decide target spatial unit - spat_unit <- spat_unit %null% spat_info + new_spat_unit <- new_spat_unit %null% spat_info # decide target feature type - if (is.null(feat_type)) { - if (!is.null(feat_info)) feat_type <- feat_info - if (!is.null(image_names)) feat_type <- "protein" + if (is.null(new_feat_type)) { + if (!is.null(feat_info)) new_feat_type <- feat_info + if (!is.null(image_names)) new_feat_type <- "protein" } - # select overlapToMatrix type - o2m_type <- if (!is.null(feat_info)) { + # select overlap type (point geoms vs intensity rasters) + overlap_type <- if (!is.null(feat_info)) { "point" } else if (!is.null(image_names)) { "intensity" + } else { + "point" # fallback assumption } - gobject <- calculateOverlap(gobject, + # calculate overlap --------------------------------------------------- # + calculate_overlap_params <- list( # common params + x = gobject, spat_info = spat_info, feat_info = feat_info, - name_overlap = feat_type, - image_names = image_names, + name_overlap = new_feat_type, poly_subset_ids = poly_subset_ids, - feat_subset_column = feat_subset_column, - feat_subset_values = feat_subset_values, - feat_count_column = feat_count_column, return_gobject = TRUE, - verbose = verbose + verbose = verbose, + ... ) - ex <- overlapToMatrix(gobject, + # method specific params + switch(overlap_type, + "point" = { + calculate_overlap_params <- c(calculate_overlap_params, + list( + feat_subset_column = feat_subset_column, + feat_subset_values = feat_subset_values, + feat_count_column = feat_count_column + ) + ) + }, + "intensity" = { + calculate_overlap_params <- c(calculate_overlap_params, + list(image_names = image_names) + ) + } + ) + + gobject <- do.call(calculateOverlap, args = calculate_overlap_params) + + # overlap to matrix --------------------------------------------------- # + + overlap_to_matrix_params <- list( + x = gobject, name = name, - poly_info = spat_info, - feat_info = feat_type, - type = o2m_type, - feat_count_column = feat_count_column, - fun = fun, + spat_info = spat_info, + feat_info = new_feat_type, # this difference is on purpose + type = overlap_type, return_gobject = FALSE, - verbose = verbose, - ... + verbose = verbose + ) + + switch(overlap_type, + "point" = { + overlap_to_matrix_params <- c(overlap_to_matrix_params, + list(feat_count_column = feat_count_column) + ) + }, + "intensity" = { + overlap_to_matrix_params <- c(overlap_to_matrix_params, + list(fun = fun) + ) + } ) - # this is moved out since overlapToMatrix doesn't have a way to - # set the spat unit (if it doesn't match spat_info) - spatUnit(ex) <- spat_unit + ex <- do.call(overlapToMatrix, args = overlap_to_matrix_params) + # this is moved out of the gobject since overlapToMatrix doesn't have a + # way to set the spat unit (if it doesn't match spat_info) + spatUnit(ex) <- new_spat_unit gobject <- setGiotto(gobject, ex, verbose = verbose) return(gobject) @@ -357,7 +397,7 @@ setMethod( } if (is.null(spat_info)) { - spat_info <- names(x@spat_info)[[1]] + spat_info <- names(x@spatial_info)[[1]] } @@ -483,6 +523,7 @@ setMethod( fun = "calculateOverlap", when = "0.4.7" ) + # return an overlap info object res <- calculateOverlap( x = x[], y = y[], @@ -495,7 +536,11 @@ setMethod( ) if (isTRUE(return_gpolygon)) { + # update schema metadata in overlap object if (is.null(name_overlap)) name_overlap <- objName(y) + prov(res) <- spatUnit(x) + spatUnit(res) <- spatUnit(x) + featType(res) <- name_overlap # ensure centroids calculated if (is.null(centroids(x))) { @@ -546,8 +591,10 @@ setMethod( verbose = TRUE, ...) { aff <- y@affine + # perform the reverse of the image's affine on the polys + inv_aff_poly <- affine(x, aff, inv = TRUE) res <- calculateOverlap( - x = affine(x, aff, inv = TRUE), + x = inv_aff_poly, y = y@raster_object, name_overlap = name_overlap %null% objName(y), poly_subset_ids = poly_subset_ids, @@ -578,6 +625,7 @@ setMethod( stop("calculateOverlap: name_overlap must be given", call. = FALSE) } + # return overlaps information res <- calculateOverlap( x = x[], y = y, @@ -587,6 +635,11 @@ setMethod( ) if (isTRUE(return_gpolygon)) { + # update schema metadata in overlap object + prov(res) <- spatUnit(x) + spatUnit(res) <- spatUnit(x) + featType(res) <- name_overlap + # ensure centroids calculated if (is.null(centroids(x))) { x <- centroids(x, append_gpolygon = TRUE) @@ -615,6 +668,7 @@ setMethod( function(x, y, poly_subset_ids = NULL, verbose = TRUE, + fun = "sum", ...) { checkmate::assert_true(terra::is.polygons(x)) GiottoUtils::package_check("exactextractr") @@ -640,24 +694,32 @@ setMethod( vmsg(.v = verbose, "Start image extract") - # perform extraction, producing list of results + eer_cname_fun <- function( # how to construct output colnames + values, # name of value layer + weights, # name of weight layer + fun_name, # value of fun + fun_value, # value associated with fun (quantile/frac/wfrac) + nvalues, # number of value layers + nweights # number of weight layers + ) { + values + } + + # perform extraction extract_res <- exactextractr::exact_extract( x = y, y = sf_x, - include_cols = "poly_ID", + append_cols = "poly_ID", + fun = fun, + colname_fun = eer_cname_fun, ... ) + data.table::setDT(extract_res) + extract_res <- .create_overlap_intensity_dt(extract_res) vmsg(.v = verbose, "End image extract") - # rbind and convert output to data.table - dt_exact <- data.table::as.data.table(do.call("rbind", extract_res)) - - # prepare output - colnames(dt_exact)[2:(length(image_names) + 1)] <- image_names - dt_exact[, coverage_fraction := NULL] - - return(dt_exact) + return(extract_res) } ) @@ -672,9 +734,11 @@ setMethod( feat_subset_column = NULL, feat_subset_values = NULL, feat_count_column = NULL, + method = c("raster", "vector"), verbose = TRUE, feat_subset_ids = deprecated(), count_info_column = deprecated()) { + method <- match.arg(method, choices = c("raster", "vector")) feat_subset_values <- GiottoUtils::deprecate_param( feat_subset_ids, feat_subset_values, fun = "calculateOverlap", when = "0.4.7" @@ -703,16 +767,49 @@ setMethod( y <- y[bool_vector] } - .calculate_overlap_raster( - spatvec = x, - pointvec = y, - count_info_column = feat_count_column, - verbose = verbose + res <- switch(method, + "raster" = .calculate_overlap_raster( + spatvec = x, + pointvec = y, + count_info_column = feat_count_column, + verbose = verbose + ), + "vector" = .calculate_overlap_vector( + spatvec = x, + pointvec = y, + keep = feat_count_column + ) ) + + .create_overlap_point_dt(x, y, res) } ) +#' @param spatvec SpatVector polygon +#' @param pointvec SpatVector points +#' @param keep other col(s) to keep +#' @keywords internal +#' @noRd +.calculate_overlap_vector <- function(spatvec, pointvec, keep = NULL) { + checkmate::assert_character(keep, null.ok = TRUE) + res <- terra::extract(spatvec, pointvec) + cn <- colnames(res) + if (all(c("id.y", "poly_ID") %in% cn)) { + res_keep <- c("id.y", "poly_ID") + } else { + res_keep <- cn[c(1L, 2L)] + } + res <- res[!is.na(res[[2]]), res_keep] # drop NAs (sparsify) + col select + if (!is.null(keep)) { + feat_keep <- do.call( + data.frame, terra::as.list(pointvec[][res[[1]], keep]) + ) # list of vectors + res <- cbind(res, feat_keep) + } + res +} + @@ -837,7 +934,85 @@ calculateOverlapRaster <- function( } } +#' @param overlap_data `data.table` of extracted intensity values per poly_ID +.create_overlap_intensity_dt <- function(overlap_data) { + odt <- new("overlapIntensityDT", data = overlap_data) + odt@nfeats <- ncol(overlap_data) - 1L + odt +} + +#' @param x from data (SpatVector) +#' @param y to data (SpatVector) +#' @param overlap_data relationships (data.frame). Expected to be numeric row +#' indices between x and y +#' @param keep additional col(s) in `y` to keep +#' @noRd +.create_overlap_point_dt <- function(x, y, overlap_data, keep = NULL) { + poly <- feat_idx <- feat <- feat_id_index <- NULL # NSE vars + # cleanup input overlap_data + checkmate::assert_data_frame(overlap_data) + data.table::setDT(overlap_data) + cnames <- colnames(overlap_data) + data.table::setnames(overlap_data, + old = c(cnames[[2]], cnames[[1]]), + new = c("poly", "feat_idx") + ) + # make relationships table sparse by removing non-overlapped features + # these results are indexed by all features, so no need to filter + # non-overlapped polys + overlap_data <- overlap_data[!is.na(poly)] + + # extract needed info from y + keep <- c("feat_ID", "feat_ID_uniq", keep) + ytab <- terra::as.data.frame(y[overlap_data$feat_idx, keep]) + + # initialize overlap object and needed ids + sids <- x$poly_ID + fids <- unique(ytab$feat_ID) + odt <- new("overlapPointDT", + spat_ids = sids, + feat_ids = fids, + nfeats = as.integer(nrow(y)) + ) + # Ensure data is stored as integer or integer-based mapping + ## - if poly/feat_idx contents are NOT integer coercible, establish a map # + if (!overlap_data[, checkmate::test_integerish(head(poly, 100))]) { + overlap_data[, poly := match(poly, sids)] + } + if (!overlap_data[, checkmate::test_integerish(head(feat_idx, 100))]) { + overlap_data[, feat_idx := match(feat_idx, fids)] + } + ## -- if still not integer, coerce to integer --------------------------- # + if (!is.integer(overlap_data$poly[1])) { + overlap_data[, poly := as.integer(poly)] + } + if (!is.integer(overlap_data$feat_idx[1])) { + overlap_data[, feat_idx := as.integer(feat_idx)] + } + + # append y attribute info + overlap_data <- cbind(overlap_data, ytab) + data.table::setnames(overlap_data, + old = c("feat_ID_uniq", "feat_ID"), + new = c("feat", "feat_id_index") + ) + if (!is.integer(overlap_data$feat[1])) { + overlap_data[, feat := as.integer(feat)] + } + # add feat_ID map + overlap_data[, feat_id_index := match(feat_id_index, odt@feat_ids)] + # remove feat_idx which may not be reliable after feature subsets + overlap_data[, feat_idx := NULL] + # set indices + data.table::setkeyv(overlap_data, "feat") + data.table::setindexv(overlap_data, "poly") + data.table::setcolorder(overlap_data, c("poly", "feat", "feat_id_index")) + # add to object + odt@data <- overlap_data + + odt +} #' @name .calculate_overlap_raster #' @title Find feature points overlapped by rasterized polygon. @@ -866,51 +1041,9 @@ calculateOverlapRaster <- function( ## overlap between raster and point if (verbose) GiottoUtils::wrap_msg("2. overlap raster and points \n") - overlap_test <- terra::extract(x = spatrast, y = pointvec) - - # add poly_ID information - if (verbose) GiottoUtils::wrap_msg("3. add polygon information \n") - overlap_test_dt <- data.table::as.data.table(overlap_test) - overlap_test_dt[, poly_ID := ID_vector[poly_i]] - - # add point information - if (verbose) GiottoUtils::wrap_msg("4. add points information \n") - pointvec_dt <- data.table::as.data.table(pointvec, geom = "XY") - - pointvec_dt_x <- pointvec_dt$x - names(pointvec_dt_x) <- pointvec_dt$geom - pointvec_dt_y <- pointvec_dt$y - names(pointvec_dt_y) <- pointvec_dt$geom - pointvec_dt_feat_ID <- pointvec_dt$feat_ID - names(pointvec_dt_feat_ID) <- pointvec_dt$geom - pointvec_dt_feat_ID_uniq <- pointvec_dt$feat_ID_uniq - names(pointvec_dt_feat_ID_uniq) <- pointvec_dt$geom - - overlap_test_dt[, x := pointvec_dt_x[ID]] - overlap_test_dt[, y := pointvec_dt_y[ID]] - overlap_test_dt[, feat_ID := pointvec_dt_feat_ID[ID]] - overlap_test_dt[, feat_ID_uniq := pointvec_dt_feat_ID_uniq[ID]] - - if (!is.null(count_info_column)) { - pointvec_dt_count <- pointvec_dt[[count_info_column]] - names(pointvec_dt_count) <- pointvec_dt$geom - overlap_test_dt[, c(count_info_column) := pointvec_dt_count[ID]] - } + overlap_res <- terra::extract(x = spatrast, y = pointvec) - if (verbose) GiottoUtils::wrap_msg("5. create overlap polygon - information \n") - overlap_test_dt_spatvector <- terra::vect( - x = as.matrix(overlap_test_dt[, c("x", "y"), with = FALSE]), - type = "points", - atts = overlap_test_dt[, c( - "poly_ID", "feat_ID", "feat_ID_uniq", - count_info_column - ), with = FALSE] - ) - names(overlap_test_dt_spatvector) <- c( - "poly_ID", "feat_ID", "feat_ID_uniq", count_info_column - ) - return(overlap_test_dt_spatvector) + return(overlap_res) } @@ -1479,37 +1612,17 @@ setMethod( o2m_args <- list( x = gpoly, - col_names = spatIDs(x, spat_unit = spat_info), - row_names = featIDs(x, feat_type = feat_info), feat_info = feat_info, feat_count_column = feat_count_column, - fun = fun, - # output = 'Matrix', # Do not specify here. methods must return - # something that operates similarly to a [matrix] - # object by default. + output = "exprobj", + sort = TRUE, type = type, - verbose = verbose, ... ) # pass to giottoPolygon method - overlapmatrix <- do.call(overlapToMatrix, args = o2m_args) - - # order matrix row/col - mat_r_names <- rownames(overlapmatrix) - mat_c_names <- colnames(overlapmatrix) - overlapmatrix <- overlapmatrix[ - match(mixedsort(mat_r_names), mat_r_names), - match(mixedsort(mat_c_names), mat_c_names) - ] - - overlapExprObj <- create_expr_obj( - name = name, - exprMat = overlapmatrix, - spat_unit = spat_info, - feat_type = feat_info, - provenance = spat_info - ) + overlapExprObj <- do.call(overlapToMatrix, args = o2m_args) + objName(overlapExprObj) <- name if (isTRUE(return_gobject)) { centroidsDT <- centroids(gpoly) %>% @@ -1781,7 +1894,54 @@ setMethod( } ) +# * overlapPointDT #### + +#' @param sort logical (default = TRUE). Whether to perform a mixed sort on +#' output matrix row and col names. +setMethod("overlapToMatrix", signature("overlapPointDT"), + function(x, + name = "raw", + sort = TRUE, + feat_count_column = NULL, + output = c("Matrix", "exprObj"), + ...) { + output <- match.arg(tolower(output), choices = c("matrix", "exprobj")) + m <- as.matrix(x, feat_count_column = feat_count_column, ...) + if (isTRUE(sort)) m <- .mixedsort_rowcols(m) + switch(output, + "matrix" = m, + "exprobj" = createExprObj( + expression_data = m, + name = name, + spat_unit = spatUnit(x), + feat_type = featType(x), + provenance = prov(x) + ) + ) +}) + +# * overlapIntensityDT #### +setMethod("overlapToMatrix", signature("overlapIntensityDT"), + function(x, + name = "raw", + sort = TRUE, + output = c("Matrix", "exprObj"), + ...) { + output <- match.arg(tolower(output), choices = c("matrix", "exprobj")) + m <- as.matrix(x, ...) + if (isTRUE(sort)) m <- .mixedsort_rowcols(m) + switch(output, + "matrix" = m, + "exprobj" = createExprObj( + expression_data = m, + name = name, + spat_unit = spatUnit(x), + feat_type = featType(x), + provenance = prov(x) + ) + ) +}) @@ -1907,7 +2067,15 @@ overlapToMatrixMultiPoly <- function(gobject, } - +.mixedsort_rowcols <- function(x) { + # order matrix row/col + mat_r_names <- rownames(x) + mat_c_names <- colnames(x) + x[ + match(mixedsort(mat_r_names), mat_r_names), + match(mixedsort(mat_c_names), mat_c_names) + ] +} #' @title overlapImagesToMatrix diff --git a/R/classes.R b/R/classes.R index 5558c85b..1a8a1e72 100644 --- a/R/classes.R +++ b/R/classes.R @@ -323,7 +323,7 @@ setClass( #' @name processParam #' @description #' Utility class that defines a data processing procedure and any params used -#' in performing it. Packages defining processing methods will create their own +#' in performing it. Packages defining processing methods will create their own #' child classes. These parameter objects are intended to be passed alongside #' the data to process to [processData()]. #' @slot param list. Named parameters to use with the intended processing @@ -339,7 +339,7 @@ setClass("processParam", contains = "VIRTUAL", slots = list(param = "list")) #' @title Spatial Value Key #' @description #' A metaprogramming object that references a set of information to get -#' from a `giotto` object when used as `svkey@get(gobject)`. +#' from a `giotto` object when used as `svkey@get(gobject)`. #' Referenced data will be retrieved as a `data.table` via [spatValues()] #' @keywords internal setClass("svkey", @@ -1387,7 +1387,7 @@ giottoPolygon <- setClass( #' @export updateGiottoPolygonObject <- function(gpoly) { if (!inherits(gpoly, "giottoPolygon")) { - stop("This function is only for giottoPoints") + stop("This function is only for giottoPolygon") } # 3.2.X adds cacheing of IDs @@ -1397,6 +1397,10 @@ updateGiottoPolygonObject <- function(gpoly) { ) } + # 0.4.7 changes overlaps representation + # intersection `SpatVector` -> `overlapInfo`-inheriting classes + gpoly <- .update_overlaps(gpoly) + gpoly } @@ -1516,10 +1520,120 @@ setClass( +## overlapInfo #### +setClass("overlapInfo", + contains = c("spatFeatData", "VIRTUAL"), + slots = list(data = "ANY") +) +setClass("overlapPoint", contains = c("overlapInfo", "VIRTUAL")) +setClass("overlapIntensity", contains = c("overlapInfo", "VIRTUAL")) + +setClass("overlapPointDT", + contains = "overlapPoint", + slots = list( + spat_ids = "character", # spat_ids are unique, no need to record npoly + feat_ids = "character", + nfeats = "integer" + ) +) +setClass("overlapIntensityDT", + contains = "overlapIntensity", + slots = list( + nfeats = "integer", # skip spat_ids/feat_ids. This data is not sparse + fun = "character" + ) +) +# update old overlaps information to new `overlapInfo` +.update_overlaps <- function(x, ...) { + + if (inherits(x, "giottoPolygon")) { + res <- .update_overlaps(x@overlaps, + poly_ids = x$poly_ID, + spat_unit = spatUnit(x), + ... + ) + x@overlaps <- res + return(x) + } + if (inherits(x, "list")) { + list_names <- names(x) + list_res <- lapply(list_names, function(ovlp_name) { + if (ovlp_name == "intensity") { + # recurse over list of intensity overlaps (can't set feat_type) + intensity_res <- .update_overlaps(x[["intensity"]], ...) + return(intensity_res) + } else { + updated_res <- .update_overlaps(x[[ovlp_name]], + feat_type = ovlp_name, + ... + ) + return(updated_res) + } + }) + names(list_res) <- list_names + return(list_res) + } + if (inherits(x, "SpatVector")) { + return(.update_overlaps_points(x, ...)) + } + if (inherits(x, "data.table")) { + return(.update_overlaps_intensity(x, ...)) + } + x # allow passthrough if not matching either signature +} + +#' @param x (SpatVector) the old overlaps representation to convert +#' @param poly_ids the `spatIDs()` of the giottoPolygon. This is since the +#' ordering of the polygon IDs within the overlaps data usually does not match. +#' @param spat_unit,feat_type spat_unit / feat_type +#' @noRd +.update_overlaps_points <- function(x, poly_ids, + spat_unit = NA_character_, feat_type = NA_character_, ...) { + checkmate::assert_character(poly_ids) + data <- terra::as.data.frame(x) + data.table::setDT(data) + odt <- new("overlapPointDT", + spat_unit = spat_unit, + feat_type = feat_type, + provenance = spat_unit, + nfeats = as.integer(nrow(data)) + ) + odt@feat_ids <- unique(data$feat_ID) + odt@spat_ids <- unique(poly_ids) + data[, feat := as.integer(feat_ID_uniq)] + data[, feat_ID_uniq := NULL] + data.table::setnames(data, + old = c("poly_ID", "feat_ID"), + new = c("poly", "feat_id_index") + ) + data <- data[!is.na(poly) & !is.na(feat),] # drop NAs + # Ensure data is stored as integer-based mapping + data[, poly := match(poly, odt@spat_ids)] + data[, feat_id_index := match(feat_id_index, odt@feat_ids)] + data.table::setkeyv(data, "feat") + data.table::setindexv(data, "poly") + data.table::setcolorder(data, c("poly", "feat", "feat_id_index")) + # add to object + odt@data <- data + odt +} +.update_overlaps_intensity <- function(x, + spat_unit = NA_character_, feat_type = NA_character_, ...) { + odt <- new("overlapIntensityDT", + spat_unit = spat_unit, + feat_type = feat_type, + provenance = spat_unit, + nfeats = as.integer(ncol(x) - 1) + ) + fids <- setdiff(names(x), "poly_ID") + x <- x[, lapply(.SD, sum), by = "poly_ID", .SDcols = fids] + odt@data <- x + odt +} ## featureNetwork class #### diff --git a/R/giotto_structures.R b/R/giotto_structures.R index 20f71db9..9216d446 100644 --- a/R/giotto_structures.R +++ b/R/giotto_structures.R @@ -288,6 +288,7 @@ combineToMultiPolygon <- function(x, groups, name = NULL) { #' @name combine_split_geoms #' @title Combine or Split Complex Geometries +#' @aliases combineGeom splitGeom #' @description #' Geometries can be either single/simple or multi with multiple closed rings #' defined as a single record. `combineGeom()` is used to combine polygons. diff --git a/R/methods-coerce.R b/R/methods-coerce.R index 0ba4f4ab..8e185847 100644 --- a/R/methods-coerce.R +++ b/R/methods-coerce.R @@ -31,6 +31,9 @@ NULL #' @description Coerce to matrix #' @param x object to coerce #' @param id_rownames logical. Retain the spatial IDs as the rownames +#' @param feat_count_column character. If provided, column in overlaps info +#' that contains count information to take into account when generating matrix. +#' This is important when point detections represent more than one count. #' @param \dots additional params to pass (none implemented) #' @examples #' sl <- GiottoData::loadSubObjectMini("spatLocsObj") @@ -147,8 +150,16 @@ as.data.table.giottoPoints <- function(x, ...) { as.data.table(x[], geomtype = "points", ...) } - - +#' @rdname as.data.table +#' @method as.data.frame overlapPointDT +#' @export +as.data.frame.overlapPointDT <- function(x, ...) { + data.frame( + poly_ID = x@spat_ids[x@data$poly], + feat_ID = x@feat_ids[x@data$feat_id_index], + feat_ID_uniq = x@data$feat # these map from feat_ID_uniq + ) +} # to matrix #### @@ -169,6 +180,40 @@ setMethod("as.matrix", signature("spatLocsObj"), function(x, id_rownames = TRUE, return(m) }) +# not using `setAs()` since we need more params +#' @rdname as.matrix +#' @export +setMethod("as.matrix", signature("overlapPointDT"), + function(x, feat_count_column = NULL, ...) { + if (!is.null(feat_count_column)) { + feat_count <- x@data[[feat_count_column]] + } else { + feat_count <- 1 + } + Matrix::sparseMatrix( + i = x@data$feat_id_index, + j = x@data$poly, + x = feat_count, + dimnames = list( + x@feat_ids, + x@spat_ids + ), + ... + ) + }) + +#' @rdname as.matrix +#' @export +setMethod("as.matrix", signature("overlapIntensityDT"), function(x, ...) { + m <- Matrix::Matrix(as.matrix( + x[][,-1]), + dimnames = list( + x[]$poly_ID, + colnames(x[][, -1]) + ) + ) + t(m) +}) diff --git a/R/methods-crop.R b/R/methods-crop.R index a0467508..6691fbc3 100644 --- a/R/methods-crop.R +++ b/R/methods-crop.R @@ -233,13 +233,7 @@ setMethod( # iterate through all overlaps, removing cell_ids that were removed in the # crop. - for (feat in names(x@overlaps)) { - cell_id_bool <- terra::as.list( - x@overlaps[[feat]] - )$poly_ID %in% x@unique_ID_cache - x@overlaps[[feat]] <- x@overlaps[[feat]][cell_id_bool] - } - + x <- .subset_overlaps_poly(x, x@unique_ID_cache) x } ) diff --git a/R/methods-extract.R b/R/methods-extract.R index 49ff1d85..9dfb1e8b 100644 --- a/R/methods-extract.R +++ b/R/methods-extract.R @@ -1059,17 +1059,153 @@ setMethod( if (is.null(x@overlaps)) { return(x) } # if no overlaps, skip following + x <- .subset_overlaps_poly(x, i = i) + x + } +) - for (feat in names(x@overlaps)) { - cell_id_bool <- terra::as.list( - x@overlaps[[feat]] - )$poly_ID %in% x@unique_ID_cache - x@overlaps[[feat]] <- x@overlaps[[feat]][cell_id_bool] +#' @description +#' Perform a feature subset to keep only those features referenced by `i` +#' across all `feat_type` requested. +#' ** If subsetting for paired sets of `i` and `feat_type`, then this function +#' should be looped. +#' @param x giottoPolygon to use +#' @param i features (within `feat_type`) to keep +#' (character, numeric, or logical) +#' @param feat_type feature types to subset features within +#' @examples +#' # this is pseudocode # +#' overlaps(gpoly) +#' gpoly <- .subset_overlaps_feat(gpoly, c("Selplg", "Mlc1"), "rna") +#' overlaps(gpoly) +#' @noRd +.subset_overlaps_feat <- function(x, i, feat_type) { + if (length(x@overlaps) == 0L) return(x) # return early if no overlaps + checkmate::assert_character(feat_type) + is_pnt_feat <- feat_type %in% names(x@overlaps) + is_int_feat <- feat_type %in% names(x@overlaps$intensity) + # return early if no relevant feat_types + if (sum(is_pnt_feat, is_int_feat) == 0) return(x) + + .do_subset <- function(o, ftypes) { + for (feat in ftypes) { + if (!inherits(o[[feat]], "overlapInfo")) { + warning("[subset overlaps feats] unrecognized overlap type") + } + o[[feat]] <- o[[feat]][, i, ids = FALSE] } + o + } - x + if (any(is_pnt_feat)) { # point overlaps + x@overlaps <- .do_subset(x@overlaps, + ftypes = feat_type[is_pnt_feat] + ) } -) + if (any(is_int_feat)) { # intensity overlaps + x@overlaps$intensity <- .do_subset(x@overlaps$intensity, + ftypes = feat_type[is_int_feat] + ) + } + + x +} + +#' @param x giottoPolygon to use +#' @param i polys to keep (character, numeric, or logical) +#' @examples +#' # this is pseudocode # +#' overlaps(gpoly) +#' gpoly <- .subset_overlaps_poly(gpoly, 1:10) +#' overlaps(gpoly) +#' @noRd +.subset_overlaps_poly <- function(x, i) { + if (length(x@overlaps) == 0L) return(x) # return early if no overlaps + for (feat in names(x@overlaps)) { + if (feat == "intensity") { + for (feat_intensity in names(x@overlaps$intensity)) { + x@overlaps$intensity[[feat_intensity]] <- + x@overlaps$intensity[[feat_intensity]][i] + } + next + } + x@overlaps[[feat]] <- x@overlaps[[feat]][i, ids = FALSE] + } + x +} + +# i should be poly ids to keep +.subset_overlap_point_dt_i <- function(x, i) { + if (is.numeric(i) || is.logical(i)) { + i <- x@spat_ids[i] + res <- .subset_overlap_point_dt_i(x, i) + return(res) + } + + poly <- NULL # NSE vars + idx <- match(i, x@spat_ids) # poly indices to keep + kept_ids <- x@spat_ids[x@spat_ids %in% i] + x@spat_ids <- i # replace spatial ids + + x@data <- x@data[poly %in% idx] + x@data[, poly := match(poly, idx)] + data.table::setkeyv(x@data, "feat") + data.table::setindex(x@data, "poly") + x +} + +.subset_overlap_point_dt_j <- function(x, j) { + # ---- convert j to numerical index ---- # + if (is.logical(j)) { + if (length(j) != length(x@feat_ids)) { + # recycle logical if needed + j <- rep(j, length.out = length(x@feat_ids)) + } + j <- which(j) + } + if (is.character(j)) { + j <- match(j, x@feat_ids) + } + + x@feat_ids <- x@feat_ids[j] # replace feature ids + + # subset on feat_id_index matches + x@data <- x@data[feat_id_index %in% j] + x@data[, feat_id_index := match(feat_id_index, j)] + data.table::setkeyv(x@data, "feat") + data.table::setindex(x@data, "poly") + x +} + +.subset_overlap_intensity_dt_i <- function(x, i) { + if (is.character(i)) { + x@data <- x@data[match(i, poly_ID)] + return(x) + } + + poly_ID <- NULL # NSE vars + nr <- nrow(x@data) + if (is.logical(i) && length(i) != nr) { + i <- rep(i, length.out = nr) # manual logical recycling for DT + } + x@data <- x@data[i,] + x +} + +.subset_overlap_intensity_dt_j <- function(x, j) { + # convert j to char col reference + if (is.numeric(j)) { + j <- j + 1L + } else if (is.logical(j)) { + j <- c(TRUE, j) + } + if (!is.character(j)) { + j <- colnames(x@data)[j] + } + j <- unique(c("poly_ID", j)) + x@data <- x@data[, .SD, .SDcols = j] + x +} # this behavior is different from normal spatvectors # SpatVector defaults to col subsetting when character is provided to i @@ -1142,6 +1278,141 @@ setMethod( } ) + + + +# * overlapPointDT #### + +setMethod("[", + signature( + x = "overlapPointDT", + i = "gIndex", + j = "missing", + drop = "missing" + ), function(x, i, j, ..., use_names = FALSE, ids = TRUE, drop) { + if (!isTRUE(ids)) { + res <- .subset_overlap_point_dt_i(x, i) + return(res) + } + .select_overlap_point_dt_i(x, i, use_names = use_names) + } +) + +setMethod("[", + signature( + x = "overlapPointDT", + i = "missing", + j = "gIndex", + drop = "missing" + ), function(x, i, j, ..., use_names = FALSE, ids = TRUE, drop) { + if (!isTRUE(ids)) { + res <- .subset_overlap_point_dt_j(x, j) + return(res) + } + .select_overlap_point_dt_j(x, j, use_names = use_names) + } +) + +setMethod("[", + signature( + x = "overlapPointDT", + i = "gIndex", + j = "gIndex", + drop = "missing" + ), + function(x, i, j, ..., use_names = FALSE, drop) { + x <- .subset_overlap_point_dt_j(x, j) + .subset_overlap_point_dt_i(x, i) + } +) + +.select_overlap_point_dt_i <- function(x, i, use_names = FALSE) { + # coerce inputs to numeric poly indexing + if (is.character(i)) { + i <- unique(i) + i <- match(i, x@spat_ids) + } else if (is.logical(i)) { + npoly <- length(x@spat_ids) + if (length(i) != npoly) { + i <- rep(i, length.out = npoly) + } + i <- which(i) + } + # numeric indexing only below + if (isTRUE(use_names)) { + return(x@feat_ids[x@data[poly %in% i, feat_id_index]]) + } + x@data[poly %in% i, feat] +} + +.select_overlap_point_dt_j <- function(x, j, use_names = FALSE) { + # coerce inputs to numeric feat_id_index + if (is.character(j)) { + j <- unique(j) + j <- match(j, x@feat_ids) + } else if (is.logical(j)) { + nfeat <- length(x@feat_ids) + if (length(j) != nfeat) { + j <- rep(j, length.out = nfeat) + } + j <- which(j) + } + # numeric indexing only below + pids <- x@data[feat_id_index %in% j, unique(poly)] + if (isTRUE(use_names)) { + return(x@spat_ids[pids]) + } + pids +} + +# * overlapIntensityDT #### + +setMethod("[", + signature( + x = "overlapIntensityDT", + i = "missing", + j = "missing", + drop = "missing" + ), + function(x, i, j, ..., drop) { + x@data + } +) + +setMethod("[", + signature( + x = "overlapIntensityDT", + i = "gIndex", + j = "missing", + drop = "missing" + ), + function(x, i, j, ..., drop) { + .subset_overlap_intensity_dt_i(x, i) + } +) + +setMethod("[", + signature(x = "overlapIntensityDT", + i = "missing", + j = "gIndex", + drop = "missing"), + function(x, i, j, ..., drop) { + .subset_overlap_intensity_dt_j(x, j) +}) + +setMethod("[", + signature(x = "overlapIntensityDT", + i = "gIndex", + j = "gIndex", + drop = "missing"), +function(x, i, j, ..., drop) { + .subset_overlap_intensity_dt_j(x, j) + .subset_overlap_intensity_dt_i(x, i) +}) + + + + # * giottoLargeImage #### #' @rdname subset_bracket #' @export diff --git a/R/methods-initialize.R b/R/methods-initialize.R index 44fe6803..746948f2 100644 --- a/R/methods-initialize.R +++ b/R/methods-initialize.R @@ -441,7 +441,8 @@ setMethod("initialize", signature("giottoAffineImage"), function(.Object, ...) { # update S4 object if needed info_list <- lapply(info_list, function(info) { try_val <- try(validObject(info), silent = TRUE) - if (inherits(try_val, "try-error")) { + if (inherits(try_val, "try-error") || + .gversion(.Object) <= "0.4.7") { info <- updateGiottoPolygonObject(info) } return(info) diff --git a/R/methods-overlaps.R b/R/methods-overlaps.R index 33510f25..cbaba19f 100644 --- a/R/methods-overlaps.R +++ b/R/methods-overlaps.R @@ -27,7 +27,10 @@ setMethod( return(x@overlaps) } else { # return named entry - return(x@overlaps[[name]]) + o <- x@overlaps[[name]] + # if still null, look in intensity overlaps + if (is.null(o)) o <- x@overlaps$intensity[[name]] } + o } ) diff --git a/R/methods-show.R b/R/methods-show.R index 9e276c37..0c94420b 100644 --- a/R/methods-show.R +++ b/R/methods-show.R @@ -667,8 +667,23 @@ setMethod( - - +## overlapPointDT #### +setMethod("show", signature("overlapPointDT"), function(object) { + cat(sprintf("<%s>\n", class(object))) + .show_spat_and_feat(object) + .show_prov(object) + cat(sprintf("* polygons : %d\n", length(object@spat_ids))) + cat(sprintf("* features : %d\n", object@nfeats)) + cat(sprintf("* relations: %d\n", nrow(object@data))) +}) +## overlapIntensityDT #### +setMethod("show", signature("overlapIntensityDT"), function(object) { + cat(sprintf("<%s>\n", class(object))) + .show_spat_and_feat(object) + .show_prov(object) + print(object@data) + cat(color_blue("* use `[]` to drop to `data.table`")) +}) diff --git a/R/subset.R b/R/subset.R index 9ac57f4d..7f1d3ed8 100644 --- a/R/subset.R +++ b/R/subset.R @@ -617,24 +617,18 @@ res_list[[spat_info]] <- spat_subset } else { # even if the spatial info is not one selected directly through - # poly_info, - # still subset subset any existing feature overlaps matching the - # feat_type - # for the feat_ids + # `poly_info`, still subset any existing feature overlaps matching + # the `feat_type` for the `feat_ids` if (!is.null(si@overlaps) && !is.null(feat_ids)) { if (isTRUE(feat_type) == ":all:") { feat_type <- names(si@overlaps) } - for (feat in names(si@overlaps)) { - if (isTRUE(feat %in% feat_type)) { - feat_id_bool <- terra::as.list( - si@overlaps[[feat]] - )$feat_ID %in% feat_ids - si@overlaps[[feat]] <- si@overlaps[[feat]][feat_id_bool] - } - } + si <- .subset_overlaps_feat(si, + i = feat_ids, + feat_type = feat_type + ) } res_list[[spat_info]] <- si @@ -1715,17 +1709,11 @@ subsetGiottoLocsSubcellular <- function( return(x) } - gpoly_overlap_names <- names(x@overlaps) - for (overlap_feat in gpoly_overlap_names) { - if (isTRUE(overlap_feat %in% names(cropped_feats))) { - feat_id_bool <- terra::as.list( - x@overlaps[[overlap_feat]] - )$feat_ID %in% - cropped_feats[[overlap_feat]] - x@overlaps[[overlap_feat]] <- x@overlaps[[ - overlap_feat - ]][feat_id_bool] - } + for (ftype in names(cropped_feats)) { + x <- .subset_overlaps_feat(x, + i = cropped_feats[[ftype]], + feat_type = ftype + ) } x }) @@ -1905,33 +1893,26 @@ subsetGiottoLocsSubcellular <- function( } } - # cell ID and feat ID subsets - if (!is.null(gpolygon@overlaps)) { - if (isTRUE(feat_type) == ":all:") feat_type <- names(gpolygon@overlaps) - - for (feat in names(gpolygon@overlaps)) { - # TODO check this for intensity image overlaps - if (!is.null(cell_ids)) { - cell_id_bool <- terra::as.list( - gpolygon@overlaps[[feat]] - )$poly_ID %in% cell_ids - gpolygon@overlaps[[feat]] <- gpolygon@overlaps[[ - feat - ]][cell_id_bool] - } + # overlap subsets + if (is.null(overlaps(gpolygon))) { + return(gpolygon) # return early if none + } - if (!is.null(feat_ids) && - isTRUE(feat %in% feat_type)) { - feat_id_bool <- terra::as.list( - gpolygon@overlaps[[feat]] - )$feat_ID %in% feat_ids - gpolygon@overlaps[[feat]] <- gpolygon@overlaps[[ - feat - ]][feat_id_bool] - } - } + if (feat_type == ":all:") { + feat_type <- names(gpolygon@overlaps) } - return(gpolygon) + + if (!is.null(cell_ids)) { + gpolygon <- .subset_overlaps_poly(gpolygon, i = cell_ids) + } + if (!is.null(feat_ids)) { + gpolygon <- .subset_overlaps_feat(gpolygon, + i = feat_ids, + feat_type = feat_type + ) + } + + gpolygon } diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R new file mode 100644 index 00000000..70fc2263 --- /dev/null +++ b/tests/testthat/test-aggregate.R @@ -0,0 +1,217 @@ +random_pts_names <- function(n, species = 20) { + local_seed(1234) + sampleset <- c(letters, LETTERS, seq(from = 0, to = 9)) + nameset <- vapply(seq_len(species), FUN = function(i) { + paste(sample(sampleset, size = 8, replace = TRUE), collapse = "") + + }, FUN.VALUE = character(1L)) + sample(nameset, replace = TRUE, size = n, prob = runif(species)) +} + +random_points_gen <- function(n = 500, extent = ext(gpoly)) { + local_seed(1234) + evect <- as.numeric(ext(extent)[]) + count <- abs(round(rnorm(n, 0, sd = 0.8))) + 1 + data.table::data.table( + id = random_pts_names(n), + x = runif(n, min = evect[[1]], max = evect[[2]]), + y = runif(n, min = evect[[3]], max = evect[[4]]), + count = count + ) +} + +g <- GiottoData::loadGiottoMini("vizgen") +gpoly <- g[["spatial_info", "aggregate"]][[1]] +gpoly@overlaps = NULL +gpoly@spatVectorCentroids <- NULL +gpts <- createGiottoPoints(random_points_gen(80000), verbose = FALSE) +imglist <- g[["images",]] +img <- imglist[[1]] + +# calculateOverlap #### +## --- poly vs pts level tests + +# these tests can change if the source test dataset changes + +test_that("calculateOverlap works for points", { + res_rast <- calculateOverlap(gpoly, gpts, verbose = FALSE) + expect_identical(names(res_rast@overlaps), "rna") + ovlp_rast <- overlaps(res_rast, "rna") + checkmate::expect_class(ovlp_rast, "overlapInfo") + expect_equal(nrow(ovlp_rast@data), 12383) + expect_identical(as.numeric(ovlp_rast@data[100,]), c(385, 685, 4)) + res_vect <- calculateOverlap(gpoly, gpts, + verbose = FALSE, method = "vector" + ) + + # larger due to double counts being possible with vector method + ovlp_vect <- overlaps(res_vect, "rna") + expect_equal(nrow(ovlp_vect@data), 12311) + expect_identical(as.numeric(ovlp_vect@data[100,]), c(12, 671, 11)) + + # with counts info + res_vect_cts <- calculateOverlap(gpoly, gpts, + feat_count_column = "count", verbose = FALSE, method = "vector" + ) + ovlp_vect_cts <- overlaps(res_vect_cts, "rna") + expect_identical( + names(ovlp_vect_cts@data), + c("poly", "feat", "feat_id_index", "count") + ) + expect_identical(as.numeric(ovlp_vect_cts@data[100,]), c(12, 671, 11, 2)) +}) + +test_that("calculateOverlap works for basic images", { + res <- calculateOverlap(gpoly, img, name = "image", verbose = FALSE, ) + o <- overlaps(res, "image") + vals <- c(514207.812, 576698.000, 593017.562) + expect_equal(head(o@data[[2]], 3), vals) +}) + +test_that("calculateOverlap works for affine images", { + res_base <- calculateOverlap(gpoly, img) + aimg <- spin(imglist[[1]], 45, x0 = 0, y0 = 0) + spin_gpoly <- spin(gpoly, 45, x0 = 0, y0 = 0) + res_aff <- calculateOverlap(spin_gpoly, aimg, + name = "affine_image", verbose = FALSE + ) + ovlp_base <- overlaps(res_base, "dapi_z0") + ovlp_aff <- overlaps(res_aff, "affine_image") + # original vs affine calculates same value + expect_equal(ovlp_base@data$mini_dataset_dapi_z0, + ovlp_aff@data$mini_dataset_dapi_z0) +}) + + +# overlapToMatrix #### +## --- poly level tests + +# test data + + + +test_that("overlapToMatrix works for point overlaps", { + res_vect <- calculateOverlap(gpoly, gpts, + verbose = FALSE, + method = "vector" + ) + ovlp_vect <- overlaps(res_vect, "rna") + expect_identical(names(ovlp_vect@data), + c("poly", "feat", "feat_id_index")) + + # with a counts column summation + res_vect_cts <- calculateOverlap(gpoly, gpts, + feat_count_column = "count", + verbose = FALSE, + method = "vector" + ) + ovlp_vect_cts <- overlaps(res_vect_cts, "rna") + expect_identical(names(ovlp_vect_cts@data), + c("poly", "feat", "feat_id_index", "count")) + + # matrix without counts + mat <- as.matrix(ovlp_vect) + mat_val <- mat["Bp5vKRUi", "104929374280991324709110264935409912418"] + expect_equal(mat_val, 4) + # matrix with counts + mat <- as.matrix(ovlp_vect_cts, feat_count_column = "count") + mat_val <- mat["Bp5vKRUi", "104929374280991324709110264935409912418"] + expect_equal(mat_val, 6) + # matrix with counts, calculated differently + ovlp_val_table <- ovlp_vect_cts@data[ + poly == match("104929374280991324709110264935409912418", + ovlp_vect_cts@spat_ids) & + feat_id_index == match("Bp5vKRUi", ovlp_vect_cts@feat_ids) + ] + ovlp_val <- sum(ovlp_val_table$count) + expect_equal(ovlp_val, 6) +}) + +test_that("overlapToMatrix works for intensity overlaps", { + res_rast <- calculateOverlap(gpoly, img, verbose = FALSE) + ovlp_rast <- overlaps(res_rast, "dapi_z0") + m <- as.matrix(ovlp_rast) + expect_equal(m[1,10], 536529.94) +}) + + +# overlap point object tests #### + +res_vect <- calculateOverlap(gpoly, gpts, + verbose = FALSE, + method = "vector" +) +ovlp <- overlaps(res_vect, "rna") + +test_that("overlap `[]` subset works", { + # expect the feat_ID_uniq overlapped by poly 9 + fuid9 <- ovlp[9] + expected_fuid9 <- c( + 1949, 4234, 6934, 9360, 11891, 12037, 13671, 13766, 14633, 14732, + 22670, 25184, 27910, 30742, 37026, 44881, 45922, 50053, 53519, 67618, + 68997, 69003, 69911, 70336, 72325, 74205, 76817 + ) + expect_equal(fuid9, expected_fuid9) + # expect the feat_ID_uniq overlapped by poly 40 + fuid40 <- ovlp[40] + expected_fuid40 <- c( + 2184, 3710, 3870, 5862, 12664, 19589, 24959, 25368, 26082, 29026, + 36516, 45774, 49727, 50094, 50514, 53664, 53834, 54290, 54365, 54534, + 55520, 59178, 66336, 66812, 70350, 73361, 75951 + ) + expect_equal(fuid40, expected_fuid40) + + # expect poly overlapping specific features + feat_idx <- match("Bp5vKRUi", ovlp@feat_ids) + poly_idx_by_fidx <- head(ovlp[, feat_idx]) + poly_idx_by_fname <- head(ovlp[, "Bp5vKRUi"]) + expect_identical(poly_idx_by_fidx, poly_idx_by_fname) + expected_idx <- c(459, 215, 11, 30, 294, 301) + expect_equal(poly_idx_by_fidx, expected_idx) +}) + +test_that("overlap `as.data.frame` works", { + res <- as.data.frame(ovlp) + expect_equal(ncol(res), 3) + expect_equal(nrow(res), 12311) + checkmate::expect_character(res$poly_ID) + checkmate::expect_character(res$feat_ID) + checkmate::expect_integer(res$feat_ID_uniq) +}) + +# aggregateFeatures #### +## --- gobject-level checks + +test_that("aggregateFeatures works and generates exprObj", { + g <- aggregateFeatures(g, + spat_info = "z0", + feat_info = "rna", + new_spat_unit = "test_spat", + new_feat_type = "test_feat", + name = "test_mat", + verbose = FALSE, + return_gobject = TRUE + ) + e <- g@expression$test_spat$test_feat$test_mat + expect_s4_class(e, "exprObj") + m <- e[] + expect_s4_class(m, "dgCMatrix") + expect_identical(head(colnames(m)), c( + "1132915601442719251817312578799507532", + "1900302715660571356090444774019116326", + "2467888014556719520437642348850497467", + "2582675971475731682260721390861103474", + "3151102251621248215463444891373423271", + "3188909098022617910378369321966273882" + )) + expect_identical(head(rownames(m)), c( + "Abcc9", "Ackr1", "Ackr3", "Adcyap1r1", "Adgra1", "Adgra2" + )) + expect_identical(objName(e), "test_mat") + expect_identical(spatUnit(e), "test_spat") + expect_identical(featType(e), "test_feat") + expect_equal(dim(e), c(337, 498)) +}) + + + From c0b072b3bc6d8f970a87f399aeab3bccf68d1c22 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Wed, 30 Apr 2025 17:49:08 -0400 Subject: [PATCH 07/45] chore: docs edits --- NAMESPACE | 1 + R/aggregate.R | 5 +++++ R/slot_show.R | 10 ++++------ man/aggregateFeatures.Rd | 21 ++++++++++++--------- man/as.data.table.Rd | 3 +++ man/as.matrix.Rd | 10 ++++++++++ man/calculateOverlap.Rd | 10 +++++++++- man/combine_split_geoms.Rd | 2 ++ man/dot-abbrev_mat.Rd | 16 ---------------- man/flip.Rd | 2 +- man/overlapToMatrix.Rd | 22 ++++++++++++++++++++++ 11 files changed, 69 insertions(+), 33 deletions(-) delete mode 100644 man/dot-abbrev_mat.Rd diff --git a/NAMESPACE b/NAMESPACE index 55aa9533..2676bd0d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,7 @@ S3method(.DollarNames,processParam) S3method(.DollarNames,spatEnrObj) S3method(.DollarNames,spatLocsObj) S3method(.DollarNames,terraVectData) +S3method(as.data.frame,overlapPointDT) S3method(as.data.table,SpatVector) S3method(as.data.table,giottoPoints) S3method(as.data.table,giottoPolygon) diff --git a/R/aggregate.R b/R/aggregate.R index d69fce2e..75b96335 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -935,6 +935,7 @@ calculateOverlapRaster <- function( } #' @param overlap_data `data.table` of extracted intensity values per poly_ID +#' @noRd .create_overlap_intensity_dt <- function(overlap_data) { odt <- new("overlapIntensityDT", data = overlap_data) odt@nfeats <- ncol(overlap_data) - 1L @@ -1896,8 +1897,10 @@ setMethod( # * overlapPointDT #### +#' @rdname overlapToMatrix #' @param sort logical (default = TRUE). Whether to perform a mixed sort on #' output matrix row and col names. +#' @export setMethod("overlapToMatrix", signature("overlapPointDT"), function(x, name = "raw", @@ -1922,6 +1925,8 @@ setMethod("overlapToMatrix", signature("overlapPointDT"), # * overlapIntensityDT #### +#' @rdname overlapToMatrix +#' @export setMethod("overlapToMatrix", signature("overlapIntensityDT"), function(x, name = "raw", diff --git a/R/slot_show.R b/R/slot_show.R index b104c871..d41b8abd 100644 --- a/R/slot_show.R +++ b/R/slot_show.R @@ -1104,12 +1104,10 @@ showGiottoImageNames <- function(gobject) { -#' @title Print abbreviated matrix -#' @name .abbrev_mat -#' @description print abbreviated matrix exprObj. Works for Matrix pkg denseMatrix, -#' matrix, data.frame and classes that inherit them. -#' @keywords internal -#' @returns abbreviated matrix exprObj + +# print abbreviated matrix exprObj. Works for Matrix pkg denseMatrix, +# matrix, data.frame and classes that inherit them. +# returns abbreviated matrix exprObj .abbrev_mat <- function(exprObj, nrows, ncols, print_prov = TRUE, header = TRUE ) { diff --git a/man/aggregateFeatures.Rd b/man/aggregateFeatures.Rd index 911d91f7..51525bb9 100644 --- a/man/aggregateFeatures.Rd +++ b/man/aggregateFeatures.Rd @@ -9,8 +9,8 @@ aggregateFeatures( spat_info = NULL, feat_info = NULL, image_names = NULL, - spat_unit = NULL, - feat_type = NULL, + new_spat_unit = NULL, + new_feat_type = NULL, name = "raw", poly_subset_ids = NULL, feat_subset_column = NULL, @@ -34,11 +34,11 @@ aggregated.} \item{image_names}{character. Name of image(s) containing intensity values to be aggregated.} -\item{spat_unit}{character (optional). Name of spatial unit to assign the -expression info to. Default is the same as \code{spat_info}.} +\item{new_spat_unit}{character (optional). Name of spatial unit to assign +the expression info to. Default is the same as \code{spat_info}.} -\item{feat_type}{character (optional). Name of feature type to assign the -expression info to. Default is the same as \code{feat_info} when used. When +\item{new_feat_type}{character (optional). Name of feature type to assign +the expression info to. Default is the same as \code{feat_info} when used. When \code{image_names} is used instead, default is "protein".} \item{name}{character. (default = "raw") Name to assign the output @@ -57,15 +57,18 @@ overlap calculation.} information. Useful in cases when more than one detection is reported per point.} -\item{fun}{character (default = "sum"). Function to aggregate image -information} +\item{fun}{character (default = "sum"). A function usable by +\code{\link[exactextractr:exact_extract]{exactextractr::exact_extract()}} to aggregate image intensity values.} \item{return_gobject}{logical (default = TRUE). Whether to return the \code{giotto} object or just the aggregated expression values as \code{exprObj} class.} \item{verbose}{logical. Whether to be verbose.} -\item{\dots}{Additional params to pass (none implemented)} +\item{\dots}{Additional params to pass to the overlap calculation method. +None implemented for point overlaps. For intensity overlaps, passes to +\code{\link[exactextractr:exact_extract]{exactextractr::exact_extract()}} and additionally the function requested +with the \code{fun} param.} } \value{ \code{giotto} when \code{return_gobject=TRUE}, \code{exprObj} when diff --git a/man/as.data.table.Rd b/man/as.data.table.Rd index 24ec8940..bf527cd8 100644 --- a/man/as.data.table.Rd +++ b/man/as.data.table.Rd @@ -5,6 +5,7 @@ \alias{as.data.table.SpatVector} \alias{as.data.table.giottoPolygon} \alias{as.data.table.giottoPoints} +\alias{as.data.frame.overlapPointDT} \title{Coerce to data.table} \usage{ \method{as.data.table}{SpatVector}( @@ -19,6 +20,8 @@ \method{as.data.table}{giottoPolygon}(x, ...) \method{as.data.table}{giottoPoints}(x, ...) + +\method{as.data.frame}{overlapPointDT}(x, ...) } \arguments{ \item{x}{The object to coerce} diff --git a/man/as.matrix.Rd b/man/as.matrix.Rd index d2560a26..523bdc0c 100644 --- a/man/as.matrix.Rd +++ b/man/as.matrix.Rd @@ -3,9 +3,15 @@ \name{as.matrix} \alias{as.matrix} \alias{as.matrix,spatLocsObj-method} +\alias{as.matrix,overlapPointDT-method} +\alias{as.matrix,overlapIntensityDT-method} \title{Coerce to matrix} \usage{ \S4method{as.matrix}{spatLocsObj}(x, id_rownames = TRUE, ...) + +\S4method{as.matrix}{overlapPointDT}(x, feat_count_column = NULL, ...) + +\S4method{as.matrix}{overlapIntensityDT}(x, ...) } \arguments{ \item{x}{object to coerce} @@ -13,6 +19,10 @@ \item{id_rownames}{logical. Retain the spatial IDs as the rownames} \item{\dots}{additional params to pass (none implemented)} + +\item{feat_count_column}{character. If provided, column in overlaps info +that contains count information to take into account when generating matrix. +This is important when point detections represent more than one count.} } \value{ matrix diff --git a/man/calculateOverlap.Rd b/man/calculateOverlap.Rd index 86796d0f..988be0de 100644 --- a/man/calculateOverlap.Rd +++ b/man/calculateOverlap.Rd @@ -69,7 +69,14 @@ ... ) -\S4method{calculateOverlap}{SpatVector,SpatRaster}(x, y, poly_subset_ids = NULL, verbose = TRUE, ...) +\S4method{calculateOverlap}{SpatVector,SpatRaster}( + x, + y, + poly_subset_ids = NULL, + verbose = TRUE, + fun = "sum", + ... +) \S4method{calculateOverlap}{SpatVector,SpatVector}( x, @@ -78,6 +85,7 @@ feat_subset_column = NULL, feat_subset_values = NULL, feat_count_column = NULL, + method = c("raster", "vector"), verbose = TRUE, feat_subset_ids = deprecated(), count_info_column = deprecated() diff --git a/man/combine_split_geoms.Rd b/man/combine_split_geoms.Rd index 164e4556..92a6d70b 100644 --- a/man/combine_split_geoms.Rd +++ b/man/combine_split_geoms.Rd @@ -2,6 +2,8 @@ % Please edit documentation in R/giotto_structures.R \name{combine_split_geoms} \alias{combine_split_geoms} +\alias{combineGeom} +\alias{splitGeom} \alias{combineGeom,giottoPolygon-method} \alias{splitGeom,giottoPolygon-method} \title{Combine or Split Complex Geometries} diff --git a/man/dot-abbrev_mat.Rd b/man/dot-abbrev_mat.Rd deleted file mode 100644 index 1cea16e2..00000000 --- a/man/dot-abbrev_mat.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_show.R -\name{.abbrev_mat} -\alias{.abbrev_mat} -\title{Print abbreviated matrix} -\usage{ -.abbrev_mat(exprObj, nrows, ncols, header = TRUE) -} -\value{ -abbreviated matrix exprObj -} -\description{ -print abbreviated matrix exprObj. Works for Matrix pkg denseMatrix, -matrix, data.frame and classes that inherit them. -} -\keyword{internal} diff --git a/man/flip.Rd b/man/flip.Rd index 2a754400..a766e6e8 100644 --- a/man/flip.Rd +++ b/man/flip.Rd @@ -31,7 +31,7 @@ \S4method{flip}{spatialNetworkObj}(x, direction = "vertical", x0 = 0, y0 = 0, ...) -\S4method{flip}{giottoLargeImage}(x, direction = "vertical", x0 = 0, y0 = 0, ...) +\S4method{flip}{giottoLargeImage}(x, direction = "vertical", x0 = 0, y0 = 0) \S4method{flip}{SpatExtent}(x, direction = "vertical", x0 = 0, y0 = 0) diff --git a/man/overlapToMatrix.Rd b/man/overlapToMatrix.Rd index da03b349..8497b8af 100644 --- a/man/overlapToMatrix.Rd +++ b/man/overlapToMatrix.Rd @@ -6,6 +6,8 @@ \alias{overlapToMatrix,giottoPolygon-method} \alias{overlapToMatrix,SpatVector-method} \alias{overlapToMatrix,data.table-method} +\alias{overlapToMatrix,overlapPointDT-method} +\alias{overlapToMatrix,overlapIntensityDT-method} \title{overlapToMatrix} \usage{ \S4method{overlapToMatrix}{giotto}( @@ -51,6 +53,23 @@ output = c("Matrix", "data.table"), aggr_function = deprecated() ) + +\S4method{overlapToMatrix}{overlapPointDT}( + x, + name = "raw", + sort = TRUE, + feat_count_column = NULL, + output = c("Matrix", "exprObj"), + ... +) + +\S4method{overlapToMatrix}{overlapIntensityDT}( + x, + name = "raw", + sort = TRUE, + output = c("Matrix", "exprObj"), + ... +) } \arguments{ \item{x}{object containing overlaps info. Can be giotto object or SpatVector @@ -87,6 +106,9 @@ points or data.table of overlaps generated from \code{calculateOverlap}} names that are expected to exist. This fixes the dimensions of the matrix since the overlaps information does not directly report rows and cols where no values were detected.} + +\item{sort}{logical (default = TRUE). Whether to perform a mixed sort on +output matrix row and col names.} } \value{ giotto object or count matrix From eab989981b17efbe9c75b3b85a55b7af0e01dd8b Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Wed, 30 Apr 2025 20:40:50 -0400 Subject: [PATCH 08/45] chore: move gpoints and gpoly updates in init giotto into updateGiottoObject() --- R/classes.R | 42 +++++++++++++++++++++++++++++++++ R/methods-initialize.R | 53 ------------------------------------------ 2 files changed, 42 insertions(+), 53 deletions(-) diff --git a/R/classes.R b/R/classes.R index 1a8a1e72..b2958c72 100644 --- a/R/classes.R +++ b/R/classes.R @@ -474,6 +474,48 @@ updateGiottoObject <- function(gobject) { # -------------------------------------------------------------------------# + # subobject updates + if (!is.null(attr(gobject, "feat_info"))) { + info_list <- get_feature_info_list(gobject) + # update S4 object if needed + info_list <- lapply(info_list, function(info) { + try_val <- try(validObject(info), silent = TRUE) + if (inherits(try_val, "try-error")) { + info <- updateGiottoPointsObject(info) + } + return(info) + }) + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### + gobject <- setFeatureInfo( + gobject = gobject, + x = info_list, + verbose = FALSE, + initialize = FALSE + ) + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### + } + if (!is.null(attr(gobject, "spatial_info"))) { + info_list <- get_polygon_info_list(gobject) + # update S4 object if needed + info_list <- lapply(info_list, function(info) { + try_val <- try(validObject(info), silent = TRUE) + if (inherits(try_val, "try-error") || + .gversion(gobject) <= "0.4.7") { + info <- updateGiottoPolygonObject(info) + } + return(info) + }) + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### + gobject <- setPolygonInfo( + gobject = gobject, + x = info_list, + verbose = FALSE, + centroids_to_spatlocs = FALSE, + initialize = FALSE + ) + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### + } + # finally, set updated version number .gversion(gobject) <- packageVersion("GiottoClass") diff --git a/R/methods-initialize.R b/R/methods-initialize.R index 746948f2..9894f811 100644 --- a/R/methods-initialize.R +++ b/R/methods-initialize.R @@ -409,59 +409,6 @@ setMethod("initialize", signature("giottoAffineImage"), function(.Object, ...) { avail_se <- list_spatial_enrichments(.Object) - ## Perform any subobject updates ## - ## ----------------------------- ## - - # Feature Info # - if (!is.null(avail_fi)) { - info_list <- get_feature_info_list(.Object) - # update S4 object if needed - info_list <- lapply(info_list, function(info) { - try_val <- try(validObject(info), silent = TRUE) - if (inherits(try_val, "try-error")) { - info <- updateGiottoPointsObject(info) - } - return(info) - }) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - .Object <- setFeatureInfo( - gobject = .Object, - x = info_list, - verbose = FALSE, - initialize = FALSE - ) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - } - - - # Spatial Info # - if (!is.null(avail_si)) { - info_list <- get_polygon_info_list(.Object) - - # update S4 object if needed - info_list <- lapply(info_list, function(info) { - try_val <- try(validObject(info), silent = TRUE) - if (inherits(try_val, "try-error") || - .gversion(.Object) <= "0.4.7") { - info <- updateGiottoPolygonObject(info) - } - return(info) - }) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - .Object <- setPolygonInfo( - gobject = .Object, - x = info_list, - verbose = FALSE, - centroids_to_spatlocs = FALSE, - initialize = FALSE - ) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - } - - - - - ## Set active/default spat_unit and feat_type ## ## ------------------------------------------ ## From 12bd1327b1e9239f09eac9af603b409d2da005b4 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Wed, 30 Apr 2025 20:41:25 -0400 Subject: [PATCH 09/45] update `combineFeatureOverlapData()` to work with new overlap structure --- R/combine_metadata.R | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/R/combine_metadata.R b/R/combine_metadata.R index f96fd0dc..53e220bd 100644 --- a/R/combine_metadata.R +++ b/R/combine_metadata.R @@ -433,15 +433,21 @@ combineFeatureOverlapData <- function(gobject, # overlap poly and feat info poly_list <- list() for (poly in poly_info) { - feat_overlap_info_spatvec <- getPolygonInfo( + feat_overlap <- getPolygonInfo( gobject = gobject, polygon_name = poly, polygon_overlap = feat ) - feat_overlap_info <- .spatvector_to_dt( - feat_overlap_info_spatvec + + pts <- getFeatureInfo(gobject, + feat_type = feat_type, + return_giottoPoints = FALSE ) + # extract overlapped points + pts <- pts[pts$feat_ID_uniq %in% feat_overlap@data$feat,] + feat_overlap_info <- .spatvector_to_dt(pts) + if (!is.null(sel_feats[[feat]])) { selected_features <- sel_feats[[feat]] feat_overlap_info <- feat_overlap_info[ From fae461363be89d3483c1d90cd636449004a7aae5 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Fri, 2 May 2025 13:24:05 -0400 Subject: [PATCH 10/45] chore: docs --- man/anndataToGiotto.Rd | 1 + man/colMeans_flex.Rd | 4 ++- man/colSums_flex.Rd | 4 ++- man/combine_split_geoms.Rd | 19 ++++++++++-- man/createExprObj.Rd | 4 +-- man/createSpatLocsObj.Rd | 29 +++++++++++++++++-- man/doDeferred.Rd | 3 ++ man/giottoToSpatialData.Rd | 6 ++-- ...{processParam.Rd => processParam-class.Rd} | 4 +-- man/readExprMatrix.Rd | 5 +++- man/rowMeans_flex.Rd | 4 ++- man/rowSums_flex.Rd | 4 ++- man/spatIDs-generic.Rd | 2 +- man/spatialdataToGiotto.Rd | 1 + man/{svKey.Rd => svkey-class.Rd} | 4 +-- man/tif_metadata.Rd | 4 +-- 16 files changed, 77 insertions(+), 21 deletions(-) rename man/{processParam.Rd => processParam-class.Rd} (92%) rename man/{svKey.Rd => svkey-class.Rd} (91%) diff --git a/man/anndataToGiotto.Rd b/man/anndataToGiotto.Rd index 853f63d9..e9b11308 100644 --- a/man/anndataToGiotto.Rd +++ b/man/anndataToGiotto.Rd @@ -9,6 +9,7 @@ anndataToGiotto( n_key_added = NULL, spatial_n_key_added = NULL, delaunay_spat_net = TRUE, + spat_enrich_key_added = NULL, spat_unit = NULL, feat_type = NULL, h5_file = NULL, diff --git a/man/colMeans_flex.Rd b/man/colMeans_flex.Rd index 892d9d23..e5d33dc6 100644 --- a/man/colMeans_flex.Rd +++ b/man/colMeans_flex.Rd @@ -4,10 +4,12 @@ \alias{colMeans_flex} \title{colMeans_flex} \usage{ -colMeans_flex(mymatrix) +colMeans_flex(mymatrix, ...) } \arguments{ \item{mymatrix}{matrix to use} + +\item{...}{other arguments passed to underlying functions} } \value{ numeric diff --git a/man/colSums_flex.Rd b/man/colSums_flex.Rd index 77786fbf..7868fcde 100644 --- a/man/colSums_flex.Rd +++ b/man/colSums_flex.Rd @@ -4,10 +4,12 @@ \alias{colSums_flex} \title{colSums_flex} \usage{ -colSums_flex(mymatrix) +colSums_flex(mymatrix, ...) } \arguments{ \item{mymatrix}{matrix to use} + +\item{...}{other arguments passed to underlying functions} } \value{ numeric diff --git a/man/combine_split_geoms.Rd b/man/combine_split_geoms.Rd index 92a6d70b..28683d16 100644 --- a/man/combine_split_geoms.Rd +++ b/man/combine_split_geoms.Rd @@ -2,10 +2,12 @@ % Please edit documentation in R/giotto_structures.R \name{combine_split_geoms} \alias{combine_split_geoms} -\alias{combineGeom} \alias{splitGeom} +\alias{combineGeom} \alias{combineGeom,giottoPolygon-method} \alias{splitGeom,giottoPolygon-method} +\alias{combineGeom,SpatVector-method} +\alias{splitGeom,SpatVector-method} \title{Combine or Split Complex Geometries} \usage{ \S4method{combineGeom}{giottoPolygon}( @@ -19,6 +21,10 @@ ) \S4method{splitGeom}{giottoPolygon}(x, fmt = "poly_\%d", previous_id = "source_id", ...) + +\S4method{combineGeom}{SpatVector}(x, by = NULL, dissolve = FALSE, fun = "mean", ...) + +\S4method{splitGeom}{SpatVector}(x, ...) } \arguments{ \item{x}{geometry class to combine or split.} @@ -46,7 +52,9 @@ the same class as \code{x} \description{ Geometries can be either single/simple or multi with multiple closed rings defined as a single record. \code{combineGeom()} is used to combine polygons. -\code{splitGeom()} breaks combined geometries down into constituent parts. +\code{splitGeom()} breaks combined geometries down into constituent parts.\cr +Avoid using the \code{SpatVector} methods. They are lower-level and does not +deal with IDs like might be expected by Giotto. } \details{ Currently, these are simple wrappers around terra's @@ -54,6 +62,13 @@ Currently, these are simple wrappers around terra's around the \code{poly_ID} column and a different name to avoid confusion with spatial feature aggregation. } +\section{Functions}{ +\itemize{ +\item \code{combineGeom(SpatVector)}: Avoid using. + +\item \code{splitGeom(SpatVector)}: Avoid using. + +}} \section{Geometry Attributes Handling}{ \itemize{ \item \code{combineGeom()} attributes are only kept if \code{by} param is used. For diff --git a/man/createExprObj.Rd b/man/createExprObj.Rd index dd46cdf3..3ebbd7dc 100644 --- a/man/createExprObj.Rd +++ b/man/createExprObj.Rd @@ -11,7 +11,7 @@ createExprObj( feat_type = "rna", provenance = NULL, misc = NULL, - expression_matrix_class = c("dgCMatrix", "DelayedArray") + expression_matrix_class = c("dgCMatrix", "DelayedArray", "dbMatrix") ) } \arguments{ @@ -28,7 +28,7 @@ createExprObj( \item{misc}{misc} \item{expression_matrix_class}{class of expression matrix to -use (e.g. 'dgCMatrix', 'DelayedArray')} +use (e.g. 'dgCMatrix', 'DelayedArray', 'dbMatrix')} } \value{ exprObj diff --git a/man/createSpatLocsObj.Rd b/man/createSpatLocsObj.Rd index 873723b6..f09cf90a 100644 --- a/man/createSpatLocsObj.Rd +++ b/man/createSpatLocsObj.Rd @@ -10,7 +10,9 @@ createSpatLocsObj( spat_unit = "cell", provenance = NULL, misc = NULL, - verbose = TRUE + numeric_format = c("pair", "triplet"), + verbose = TRUE, + ... ) } \arguments{ @@ -25,7 +27,12 @@ information (if applicable)} \item{misc}{misc} -\item{verbose}{be verbose} +\item{numeric_format}{character. One of \code{"pair"} (default) or \code{"triplet"}. +Whether \code{numeric} inputs should be understood as XY pairs or XYZ triplets.} + +\item{verbose}{verbosity} + +\item{\dots}{additional params to pass} } \value{ spatLocsObj @@ -34,11 +41,27 @@ spatLocsObj Create an S4 spatLocsObj } \examples{ +# from data.frame x <- data.frame( cell_ID = c("cell_1", "cell_2", "cell_3"), sdimx = c(6637.881, 6471.978, 6801.610), sdimy = c(-5140.465, -4883.541, -4968.685) ) +s1 <- createSpatLocsObj(coordinates = x, name = "raw") +plot(s1) + +# from matrix +m <- matrix(c(2 ,3, 4, 2), ncol = 2) +rownames(m) <- c("cell1", "cell2") +s2 <- createSpatLocsObj(m) +plot(s2) -createSpatLocsObj(coordinates = x, name = "raw") +# from numeric xy pairs +num2d <- c(1, 3, 5, 9) +s3 <- createSpatLocsObj(num2d) +plot(s3) +# from numeric xyz triplets +num3d <- c(3, 2, 9, 3, 8, 5) +s4 <- createSpatLocsObj(num3d, numeric_format = "triplet") +plot(s4) } diff --git a/man/doDeferred.Rd b/man/doDeferred.Rd index c384843c..53615913 100644 --- a/man/doDeferred.Rd +++ b/man/doDeferred.Rd @@ -18,6 +18,9 @@ evaluating} \item{...}{additional args to pass} } +\value{ +giottoLargeImage +} \description{ Force deferred/lazy operations. } diff --git a/man/giottoToSpatialData.Rd b/man/giottoToSpatialData.Rd index 2317e7a3..7d96990c 100644 --- a/man/giottoToSpatialData.Rd +++ b/man/giottoToSpatialData.Rd @@ -23,7 +23,8 @@ giottoToSpatialData( \item{spot_radius}{radius of the spots} -\item{python_path}{path to python executable within a conda/miniconda environment} +\item{python_path}{path to python executable within a conda/miniconda +environment} \item{env_name}{name of environment containing python_path executable} @@ -36,5 +37,6 @@ SpatialData object saved on disk. Converts a Giotto object to SpatialData object } \details{ -Function in beta. Converts and saves a Giotto object in SpatialData format on disk. +Function in beta. Converts and saves a Giotto object in SpatialData +format on disk. } diff --git a/man/processParam.Rd b/man/processParam-class.Rd similarity index 92% rename from man/processParam.Rd rename to man/processParam-class.Rd index da4994a0..bd815077 100644 --- a/man/processParam.Rd +++ b/man/processParam-class.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/classes.R \docType{class} -\name{processParam} -\alias{processParam} +\name{processParam-class} +\alias{processParam-class} \title{Parameter Classes for Data Processing Operations} \description{ Utility class that defines a data processing procedure and any params used diff --git a/man/readExprMatrix.Rd b/man/readExprMatrix.Rd index f6864bee..d3537cbc 100644 --- a/man/readExprMatrix.Rd +++ b/man/readExprMatrix.Rd @@ -9,7 +9,8 @@ readExprMatrix( cores = determine_cores(), transpose = FALSE, feat_type = "rna", - expression_matrix_class = c("dgCMatrix", "DelayedArray") + expression_matrix_class = c("dgCMatrix", "DelayedArray"), + ... ) } \arguments{ @@ -23,6 +24,8 @@ readExprMatrix( \item{expression_matrix_class}{class of expression matrix to use (e.g. 'dgCMatrix', 'DelayedArray')} + +\item{...}{additional params to pass} } \value{ sparse matrix diff --git a/man/rowMeans_flex.Rd b/man/rowMeans_flex.Rd index 494c5927..d6e5346e 100644 --- a/man/rowMeans_flex.Rd +++ b/man/rowMeans_flex.Rd @@ -4,10 +4,12 @@ \alias{rowMeans_flex} \title{rowMeans_flex} \usage{ -rowMeans_flex(mymatrix) +rowMeans_flex(mymatrix, ...) } \arguments{ \item{mymatrix}{matrix to use} + +\item{...}{other arguments passed to underlying functions} } \value{ numeric diff --git a/man/rowSums_flex.Rd b/man/rowSums_flex.Rd index 0ec49b05..1dde000a 100644 --- a/man/rowSums_flex.Rd +++ b/man/rowSums_flex.Rd @@ -4,10 +4,12 @@ \alias{rowSums_flex} \title{rowSums_flex} \usage{ -rowSums_flex(mymatrix) +rowSums_flex(mymatrix, ...) } \arguments{ \item{mymatrix}{matrix to use} + +\item{...}{other arguments passed to \code{\link{rowSums}}} } \value{ numeric diff --git a/man/spatIDs-generic.Rd b/man/spatIDs-generic.Rd index b845c911..8f82c92c 100644 --- a/man/spatIDs-generic.Rd +++ b/man/spatIDs-generic.Rd @@ -118,7 +118,7 @@ featIDs(gpoints) # ID replacements (currently only giottoPolygons) polys <- g[["spatial_info"]][[1]] -polys@overlaps <- NULL # make NULL to avoid a warning +slot(polys, "overlaps") <- NULL # make NULL to avoid a warning head(spatIDs(polys)) spatIDs(polys) <- paste0("poly_", seq_len(nrow(polys))) head(spatIDs(polys)) diff --git a/man/spatialdataToGiotto.Rd b/man/spatialdataToGiotto.Rd index 935e7dbe..1bbeda9b 100644 --- a/man/spatialdataToGiotto.Rd +++ b/man/spatialdataToGiotto.Rd @@ -9,6 +9,7 @@ spatialdataToGiotto( n_key_added = NULL, spatial_n_key_added = NULL, delaunay_spat_net = TRUE, + spat_enrich_key_added = NULL, spat_unit = NULL, feat_type = NULL, python_path = NULL, diff --git a/man/svKey.Rd b/man/svkey-class.Rd similarity index 91% rename from man/svKey.Rd rename to man/svkey-class.Rd index b00238e6..07111833 100644 --- a/man/svKey.Rd +++ b/man/svkey-class.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/classes.R \docType{class} -\name{svkey} -\alias{svkey} +\name{svkey-class} +\alias{svkey-class} \title{Spatial Value Key} \description{ A metaprogramming object that references a set of information to get diff --git a/man/tif_metadata.Rd b/man/tif_metadata.Rd index 1cfcfd3c..c2903112 100644 --- a/man/tif_metadata.Rd +++ b/man/tif_metadata.Rd @@ -36,7 +36,7 @@ for \code{.qptiff}.} with figuring out which is most appropriate.} \item{output}{character. One of "data.frame" to return a data.frame of the -attributes information of the xml node, "xmL" for an {xml2} representation +attributes information of the xml node, "xmL" for an \{xml2\} representation of the node, "list" for an R native list (note that many items in the list may have overlapping names that make indexing difficult), or "structure" to invisibly return NULL, but print the structure of the XML @@ -47,7 +47,7 @@ list of image metadata information } \description{ Use the python package tifffile to get the the XML metadata -of a .tif file. The R package {xml2} is then used to work with it to +of a .tif file. The R package \{xml2\} is then used to work with it to retrieve specific nodes in the xml data and extract data. } \section{Functions}{ From e6f82e14aa1e0c3af986afe345038eb168c29bc2 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Fri, 2 May 2025 13:55:17 -0400 Subject: [PATCH 11/45] fix: scoping on local seed in tests --- tests/testthat/test-aggregate.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R index 70fc2263..4749aea2 100644 --- a/tests/testthat/test-aggregate.R +++ b/tests/testthat/test-aggregate.R @@ -1,5 +1,5 @@ random_pts_names <- function(n, species = 20) { - local_seed(1234) + GiottoUtils::local_seed(1234) sampleset <- c(letters, LETTERS, seq(from = 0, to = 9)) nameset <- vapply(seq_len(species), FUN = function(i) { paste(sample(sampleset, size = 8, replace = TRUE), collapse = "") @@ -9,7 +9,7 @@ random_pts_names <- function(n, species = 20) { } random_points_gen <- function(n = 500, extent = ext(gpoly)) { - local_seed(1234) + GiottoUtils::local_seed(1234) evect <- as.numeric(ext(extent)[]) count <- abs(round(rnorm(n, 0, sd = 0.8))) + 1 data.table::data.table( From f9e00176f2cb8de6c542a756ca18d94afb290956 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Fri, 2 May 2025 17:01:50 -0400 Subject: [PATCH 12/45] fix: as.matrix method for points overlaps --- R/methods-coerce.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/methods-coerce.R b/R/methods-coerce.R index 8e185847..31116c28 100644 --- a/R/methods-coerce.R +++ b/R/methods-coerce.R @@ -198,6 +198,10 @@ setMethod("as.matrix", signature("overlapPointDT"), x@feat_ids, x@spat_ids ), + dims = c( + length(x@feat_ids), + length(x@spat_ids) + ), ... ) }) From 0a7823db1df30bd29ca2b368407d72b54f0df898 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Fri, 2 May 2025 20:51:35 -0400 Subject: [PATCH 13/45] enh: make subsetting point overlaps more robust --- R/methods-extract.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/methods-extract.R b/R/methods-extract.R index a72c1dc9..731e95d0 100644 --- a/R/methods-extract.R +++ b/R/methods-extract.R @@ -1138,14 +1138,12 @@ setMethod( .subset_overlap_point_dt_i <- function(x, i) { if (is.numeric(i) || is.logical(i)) { i <- x@spat_ids[i] - res <- .subset_overlap_point_dt_i(x, i) - return(res) } poly <- NULL # NSE vars idx <- match(i, x@spat_ids) # poly indices to keep - kept_ids <- x@spat_ids[x@spat_ids %in% i] - x@spat_ids <- i # replace spatial ids + idx <- idx[!is.na(idx)] # drop unmatched NAs + x@spat_ids <- x@spat_ids[x@spat_ids %in% i] # replace spatial ids x@data <- x@data[poly %in% idx] x@data[, poly := match(poly, idx)] From 9e75f3e7c84991d8726051c060ec68c7950c11d6 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Fri, 2 May 2025 20:51:52 -0400 Subject: [PATCH 14/45] enh: dim() and rbind() for point overlaps --- R/methods-dims.R | 8 ++++++++ R/methods-rbind.R | 39 ++++++++++++++++++++++++++++++++++++++- 2 files changed, 46 insertions(+), 1 deletion(-) diff --git a/R/methods-dims.R b/R/methods-dims.R index 3c5d36af..df2fce17 100644 --- a/R/methods-dims.R +++ b/R/methods-dims.R @@ -145,3 +145,11 @@ setMethod("dim", signature("giottoPolygon"), function(x) dim(x[])) #' @rdname dims-generic #' @export setMethod("dim", signature("giottoPoints"), function(x) dim(x[])) + +#' @rdname dims_generic +#' @export +setMethod("dim", signature("overlapPointDT"), function(x) dim(x@data)) + +#' @rdname dims_generic +#' @export +setMethod("dim", signature("overlapIntensityDT"), function(x) dim(x@data)) diff --git a/R/methods-rbind.R b/R/methods-rbind.R index d31a47d7..e19969be 100644 --- a/R/methods-rbind.R +++ b/R/methods-rbind.R @@ -90,6 +90,36 @@ setMethod( } ) +#' @rdname rbind-generic +#' @export +setMethod("rbind2", signature("overlapPointDT", "overlapPointDT"), + function(x, y, ...) { + comb_spat <- unique(c(x@spat_ids, y@spat_ids)) + comb_feat <- unique(c(x@feat_ids, y@feat_ids)) + + x_spat_map <- match(x@spat_ids, comb_spat) + y_spat_map <- match(y@spat_ids, comb_spat) + x_feat_map <- match(x@feat_ids, comb_feat) + y_feat_map <- match(y@feat_ids, comb_feat) + + # replace id dictionaries for x (output object) + x@spat_ids <- comb_spat + x@feat_ids <- comb_feat + + # remap indices + x@data[, poly := x_spat_map[poly]] + y@data[, poly := y_spat_map[poly]] + x@data[, feat_id_index := x_feat_map[feat_id_index]] + y@data[, feat_id_index := y_feat_map[feat_id_index]] + + x@data <- rbind(x@data, y@data) + x@nfeats <- x@nfeats + y@nfeats + + data.table::setkeyv(x@data, "feat") + data.table::setindex(x@data, "poly") + x + } +) if (!isGeneric("rbind")) setGeneric("rbind", signature = "...") @@ -113,7 +143,14 @@ setMethod("rbind", "spatLocsObj", function(..., deparse.level = 1) { } }) - +setMethod("rbind", "overlapPointDT", function(..., deparse.level = 1) { + if (nargs() <= 2L) { + rbind2(...) + } else { + xs <- list(...) + rbind2(xs[[1L]], do.call(Recall, xs[-1L])) + } +}) # internals #### From bd6c56b51c7d759fabe412bd627ab407282df634 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Fri, 2 May 2025 20:52:13 -0400 Subject: [PATCH 15/45] fix: `aggregateStacksPolygonOverlaps()` for new point overlap implementation --- R/aggregate.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/R/aggregate.R b/R/aggregate.R index 75b96335..80116be6 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -2674,24 +2674,24 @@ aggregateStacksPolygonOverlaps <- function(gobject, for (i in seq_len(length(spat_units))) { spat_unit <- spat_units[i] - vecDT <- gobject@spatial_info[[spat_unit]]@overlaps[[feat_type]] + ovlp <- getPolygonInfo(gobject, + polygon_name = spat_unit, + polygon_overlap = feat_type + ) + # vecDT <- gobject@spatial_info[[spat_unit]]@overlaps[[feat_type]] - if (!is.null(vecDT)) { - vecDT <- .spatvector_to_dt(vecDT) - vecDT[, "stack" := i] - polygon_list[[spat_unit]] <- vecDT + if (!is.null(ovlp)) { + ovlp@data[, "stack" := i] + polygon_list[[spat_unit]] <- ovlp } } if (length(polygon_list) == 0) { wrap_msg("No feature overlaps found for stack aggregation \n") } else { - polygon_DT <- data.table::rbindlist(polygon_list) - polygon <- .dt_to_spatvector_points( - dt = polygon_DT, - include_values = TRUE - ) - gobject@spatial_info[[new_spat_unit]]@overlaps[[feat_type]] <- polygon + comb_ovlp <- do.call(rbind, polygon_list) + gobject@spatial_info[[new_spat_unit]]@overlaps[[feat_type]] <- + comb_ovlp } return(gobject) From c303535a90fd15c632862131f533db2fb2420c1a Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Sun, 4 May 2025 05:51:50 -0400 Subject: [PATCH 16/45] fix: remove now unecessary handling for overlaps saving --- R/save_load.R | 36 ------------------------------------ 1 file changed, 36 deletions(-) diff --git a/R/save_load.R b/R/save_load.R index ffe2cfbc..b054b588 100644 --- a/R/save_load.R +++ b/R/save_load.R @@ -177,42 +177,6 @@ saveGiotto <- function( filename = filename, overwrite = TRUE ) } - - # overlap information - if (!is.null(gobject@spatial_info[[spatinfo]]@overlaps)) { - for (feature in names( - gobject@spatial_info[[spatinfo]]@overlaps - )) { - if (feature == "intensity") next - # intensities are stored as data.table - # They are already saveable with the rest of the gobject. - # Skip. - - # write names of spatvector - spatvecnames <- names( - gobject@spatial_info[[spatinfo]]@overlaps[[feature]] - ) - filename_names <- paste0( - spatinfo_dir, "/", feature, "_", - spatinfo, "_spatInfo_spatVectorOverlaps_names.txt" - ) - write.table( - x = spatvecnames, file = filename_names, - col.names = FALSE, row.names = FALSE - ) - - # write spatvector - filename <- paste0( - spatinfo_dir, "/", feature, "_", - spatinfo, - "_spatInfo_spatVectorOverlaps.shp" - ) - terra::writeVector( - gobject@spatial_info[[spatinfo]]@overlaps[[feature]], - filename = filename, overwrite = TRUE - ) - } - } } } From 9f654dcfcfa6b97de1c64dd0d00c2c9d88810a2b Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Sun, 4 May 2025 06:52:00 -0400 Subject: [PATCH 17/45] fix: incorrect overlap point feat_id tracking --- R/aggregate.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/aggregate.R b/R/aggregate.R index 80116be6..7eeec498 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -760,6 +760,9 @@ setMethod( x <- x[x$poly_ID %in% poly_subset_ids] } + # preserve total all feat ids present + feat_ids <- unique(y$feat_ID) + # * subset points if needed # e.g. to select transcripts within a z-plane if (!is.null(feat_subset_column) && !is.null(feat_subset_values)) { @@ -781,7 +784,7 @@ setMethod( ) ) - .create_overlap_point_dt(x, y, res) + .create_overlap_point_dt(x, y, res, feat_ids = feat_ids) } ) @@ -948,7 +951,8 @@ calculateOverlapRaster <- function( #' indices between x and y #' @param keep additional col(s) in `y` to keep #' @noRd -.create_overlap_point_dt <- function(x, y, overlap_data, keep = NULL) { +.create_overlap_point_dt <- function(x, y, + overlap_data, keep = NULL, feat_ids) { poly <- feat_idx <- feat <- feat_id_index <- NULL # NSE vars # cleanup input overlap_data checkmate::assert_data_frame(overlap_data) @@ -972,7 +976,7 @@ calculateOverlapRaster <- function( fids <- unique(ytab$feat_ID) odt <- new("overlapPointDT", spat_ids = sids, - feat_ids = fids, + feat_ids = feat_ids, nfeats = as.integer(nrow(y)) ) From 2630dbb860911ba6ac19619407ada8064973f5d9 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Sun, 4 May 2025 06:52:26 -0400 Subject: [PATCH 18/45] update: test for new param names --- tests/testthat/test-create_mini_vizgen.R | 24 +++++++++++------------- 1 file changed, 11 insertions(+), 13 deletions(-) diff --git a/tests/testthat/test-create_mini_vizgen.R b/tests/testthat/test-create_mini_vizgen.R index da2de8dc..1a9e7f26 100644 --- a/tests/testthat/test-create_mini_vizgen.R +++ b/tests/testthat/test-create_mini_vizgen.R @@ -141,7 +141,7 @@ test_that("giottoLargeImages are created", { vizsubc <- addGiottoImage( gobject = vizsubc, - largeImages = imagelist + images = imagelist ) test_that("images were added", { @@ -159,20 +159,20 @@ test_that("images were added", { # we can set a global option or specify this for each command # options('giotto.spat_unit' = 'z1') # now you don't need to think about setting spat_unit each time -vizsubc <- calculateOverlapRaster( +vizsubc <- calculateOverlap( vizsubc, - spatial_info = "z0", + spat_info = "z0", feat_info = "rna", feat_subset_column = "global_z", - feat_subset_ids = 0 + feat_subset_values = 0 ) -vizsubc <- calculateOverlapRaster( +vizsubc <- calculateOverlap( vizsubc, - spatial_info = "z1", + spat_info = "z1", feat_info = "rna", feat_subset_column = "global_z", - feat_subset_ids = 1 + feat_subset_values = 1 ) @@ -194,22 +194,20 @@ nfeats <- length(feats) test_that("overlaps are calculated", { - expect_class(overlaps(z0_gpoly)$rna, "SpatVector") - expect_class(overlaps(z0_gpoly)$rna, "SpatVector") - expect_identical(terra::geomtype(overlaps(z0_gpoly)$rna), "points") - expect_identical(terra::geomtype(overlaps(z0_gpoly)$rna), "points") + expect_class(overlaps(z0_gpoly)$rna, "overlapPointDT") + expect_class(overlaps(z0_gpoly)$rna, "overlapPointDT") }) vizsubc <- overlapToMatrix( vizsubc, - poly_info = "z0", + spat_info = "z0", feat_info = "rna", name = "raw" ) vizsubc <- overlapToMatrix( vizsubc, - poly_info = "z1", + spat_info = "z1", feat_info = "rna", name = "raw" ) From b1be26f9bfd4fb6caf0c21e475d10a3814e400d9 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Sun, 4 May 2025 06:55:07 -0400 Subject: [PATCH 19/45] chore: update test expected based on changes --- tests/testthat/test-aggregate.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R index 4749aea2..ec683a61 100644 --- a/tests/testthat/test-aggregate.R +++ b/tests/testthat/test-aggregate.R @@ -39,7 +39,7 @@ test_that("calculateOverlap works for points", { ovlp_rast <- overlaps(res_rast, "rna") checkmate::expect_class(ovlp_rast, "overlapInfo") expect_equal(nrow(ovlp_rast@data), 12383) - expect_identical(as.numeric(ovlp_rast@data[100,]), c(385, 685, 4)) + expect_identical(as.numeric(ovlp_rast@data[100,]), c(385, 685, 12)) res_vect <- calculateOverlap(gpoly, gpts, verbose = FALSE, method = "vector" ) @@ -47,7 +47,7 @@ test_that("calculateOverlap works for points", { # larger due to double counts being possible with vector method ovlp_vect <- overlaps(res_vect, "rna") expect_equal(nrow(ovlp_vect@data), 12311) - expect_identical(as.numeric(ovlp_vect@data[100,]), c(12, 671, 11)) + expect_identical(as.numeric(ovlp_vect@data[100,]), c(12, 671, 3)) # with counts info res_vect_cts <- calculateOverlap(gpoly, gpts, @@ -58,7 +58,7 @@ test_that("calculateOverlap works for points", { names(ovlp_vect_cts@data), c("poly", "feat", "feat_id_index", "count") ) - expect_identical(as.numeric(ovlp_vect_cts@data[100,]), c(12, 671, 11, 2)) + expect_identical(as.numeric(ovlp_vect_cts@data[100,]), c(12, 671, 3, 2)) }) test_that("calculateOverlap works for basic images", { From 1092a3fa9cb581008da1012c75bd3b07ed503828 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Sun, 4 May 2025 20:32:36 -0400 Subject: [PATCH 20/45] fix: remove unused overlap reading --- R/save_load.R | 52 --------------------------------------------------- 1 file changed, 52 deletions(-) diff --git a/R/save_load.R b/R/save_load.R index b054b588..f681e12e 100644 --- a/R/save_load.R +++ b/R/save_load.R @@ -550,13 +550,6 @@ loadGiotto <- function(path_to_folder, verbose = verbose ) - # load overlaps of gpoly - gobject <- .load_giotto_spatial_info_overlaps( - gobject = gobject, - manifest = manifest, - verbose = verbose - ) - return(gobject) } @@ -606,51 +599,6 @@ loadGiotto <- function(path_to_folder, return(gobject) } -# load and append to gobject the polygons overlaps information -.load_giotto_spatial_info_overlaps <- function(gobject, manifest, verbose = NULL) { - ## 3.3. overlaps - vmsg(.v = verbose, "3.3 read Giotto spatial overlap information \n") - - si <- get_polygon_info_list(gobject) # none case taken care of in 3.1 - spats <- names(si) - - # These files are optional, depending on if they have been calculated. - # They may not exist - # They are named in "feattype_spatunit_postfix.extension" convention - - for (spat in spats) { - feats <- .gpoly_overlap_names(si[[spat]], type = "point") - if (is.null(feats)) next # goto next spat_unit if no overlaps - - for (feat in feats) { - # format: feattype_spatunit - comb <- paste(feat, spat, sep = "_") - - # format: feattype_spatunit_postfix.extension - shp_file <- paste0(comb, "_spatInfo_spatVectorOverlaps.shp") - txt_file <- paste0(comb, "_spatInfo_spatVectorOverlaps_names.txt") - load_shp <- manifest[[shp_file]] - load_txt <- manifest[[txt_file]] - - vmsg( - .v = verbose, .is_debug = TRUE, .initial = " ", - sprintf("[%s and %s] %s", spat, feat, basename(load_shp)) - ) - spatVector <- terra::vect(load_shp) - - # read in original column names - spatVector_names <- data.table::fread( - input = load_txt, header = FALSE - )[["V1"]] - names(spatVector) <- spatVector_names - - # append - gobject@spatial_info[[spat]]@overlaps[[feat]] <- spatVector - } - } - - return(gobject) -} # the actual reconnection step is done through reconnect() after this step now From 1feeea2b5d70d9f0fd98a2a761733c95e04623ff Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Sun, 4 May 2025 20:47:42 -0400 Subject: [PATCH 21/45] fix: make overlap reading versioned --- R/save_load.R | 56 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/R/save_load.R b/R/save_load.R index f681e12e..676c5116 100644 --- a/R/save_load.R +++ b/R/save_load.R @@ -550,6 +550,13 @@ loadGiotto <- function(path_to_folder, verbose = verbose ) + # load overlaps of gpoly + gobject <- .load_giotto_spatial_info_overlaps( + gobject = gobject, + manifest = manifest, + verbose = verbose + ) + return(gobject) } @@ -599,6 +606,55 @@ loadGiotto <- function(path_to_folder, return(gobject) } +# load and append to gobject the polygons overlaps information +.load_giotto_spatial_info_overlaps <- function(gobject, manifest, verbose = NULL) { + # objects from GiottoClass v0.5 and onwards do not need this for overlaps + if (!"versions" %in% attributes(gobject)) return(gobject) + if (.gversion(gobject) >= "0.5.0") return(gobject) + + ## 3.3. overlaps + vmsg(.v = verbose, "3.3 read Giotto spatial overlap information \n") + + si <- get_polygon_info_list(gobject) # none case taken care of in 3.1 + spats <- names(si) + + # These files are optional, depending on if they have been calculated. + # They may not exist + # They are named in "feattype_spatunit_postfix.extension" convention + + for (spat in spats) { + feats <- .gpoly_overlap_names(si[[spat]], type = "point") + if (is.null(feats)) next # goto next spat_unit if no overlaps + + for (feat in feats) { + # format: feattype_spatunit + comb <- paste(feat, spat, sep = "_") + + # format: feattype_spatunit_postfix.extension + shp_file <- paste0(comb, "_spatInfo_spatVectorOverlaps.shp") + txt_file <- paste0(comb, "_spatInfo_spatVectorOverlaps_names.txt") + load_shp <- manifest[[shp_file]] + load_txt <- manifest[[txt_file]] + + vmsg( + .v = verbose, .is_debug = TRUE, .initial = " ", + sprintf("[%s and %s] %s", spat, feat, basename(load_shp)) + ) + spatVector <- terra::vect(load_shp) + + # read in original column names + spatVector_names <- data.table::fread( + input = load_txt, header = FALSE + )[["V1"]] + names(spatVector) <- spatVector_names + + # append + gobject@spatial_info[[spat]]@overlaps[[feat]] <- spatVector + } + } + + return(gobject) +} # the actual reconnection step is done through reconnect() after this step now From 7c0ce210a369a278be0ac16e160b4affcc1f30a6 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Sun, 4 May 2025 20:58:47 -0400 Subject: [PATCH 22/45] fix: checking logic for overlaps load --- R/save_load.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/R/save_load.R b/R/save_load.R index 676c5116..862ab5d4 100644 --- a/R/save_load.R +++ b/R/save_load.R @@ -609,8 +609,9 @@ loadGiotto <- function(path_to_folder, # load and append to gobject the polygons overlaps information .load_giotto_spatial_info_overlaps <- function(gobject, manifest, verbose = NULL) { # objects from GiottoClass v0.5 and onwards do not need this for overlaps - if (!"versions" %in% attributes(gobject)) return(gobject) - if (.gversion(gobject) >= "0.5.0") return(gobject) + if ("versions" %in% names(attributes(gobject))) { + if (.gversion(gobject) >= "0.5.0") return(gobject) + } ## 3.3. overlaps vmsg(.v = verbose, "3.3 read Giotto spatial overlap information \n") From a8bbfb6f2b7f4864b5ba04d74e418e853b621710 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Mon, 5 May 2025 09:12:11 -0400 Subject: [PATCH 23/45] chore: docs --- man/rbind-generic.Rd | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/rbind-generic.Rd b/man/rbind-generic.Rd index 8b89e3bf..aa8cf2cc 100644 --- a/man/rbind-generic.Rd +++ b/man/rbind-generic.Rd @@ -6,6 +6,7 @@ \alias{rbind2,featMetaObj,featMetaObj-method} \alias{rbind2,spatLocsObj,spatLocsObj-method} \alias{rbind2,giottoPolygon,giottoPolygon-method} +\alias{rbind2,overlapPointDT,overlapPointDT-method} \title{Combine objects by rows (Giotto-related)} \usage{ \S4method{rbind2}{cellMetaObj,cellMetaObj}(x, y, ...) @@ -15,6 +16,8 @@ \S4method{rbind2}{spatLocsObj,spatLocsObj}(x, y, ...) \S4method{rbind2}{giottoPolygon,giottoPolygon}(x, y, add_list_ID = TRUE, ...) + +\S4method{rbind2}{overlapPointDT,overlapPointDT}(x, y, ...) } \arguments{ \item{x}{item 1 to rbind} From e18de8521983b358e8a8470bbb1535bda9bdb8a0 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Thu, 15 May 2025 12:39:39 -0400 Subject: [PATCH 24/45] Revert "chore: catch up to staging" This reverts commit 47e2247ed138b9d314eb11fd4bc56f67388b2da9, reversing changes made to a8bbfb6f2b7f4864b5ba04d74e418e853b621710. --- .github/workflows/staging_branch_workflow.yml | 22 +- DESCRIPTION | 4 +- NAMESPACE | 13 +- NEWS.md | 26 +- R/aggregate.R | 3 +- R/auxilliary.R | 25 +- R/classes.R | 9 - R/combine_metadata.R | 56 +- R/create.R | 91 +-- R/data_evaluation.R | 2 +- R/generics.R | 5 +- R/images.R | 5 +- R/interoperability.R | 78 ++- R/join.R | 1 - R/methods-area.R | 26 +- R/methods-convHull.R | 60 ++ R/methods-hull.R | 77 --- R/methods-initialize.R | 2 +- R/package_imports.R | 3 +- R/save_load.R | 37 +- R/slot_accessors.R | 2 +- R/spatial_query.R | 519 ++++-------------- README.Rmd | 2 +- README.md | 3 +- man/anndataToGiotto.Rd | 17 +- man/area.Rd | 20 +- man/combineCellData.Rd | 20 +- man/convHull.Rd | 54 ++ man/createGiottoPolygon.Rd | 35 +- man/hull.Rd | 61 -- man/processParam-class.Rd | 1 - man/spatQuery.Rd | 218 -------- man/spatQueryGiottoPolygons.Rd | 43 ++ man/spatialdataToGiotto.Rd | 15 +- 34 files changed, 434 insertions(+), 1121 deletions(-) create mode 100644 R/methods-convHull.R delete mode 100644 R/methods-hull.R create mode 100644 man/convHull.Rd delete mode 100644 man/hull.Rd delete mode 100644 man/spatQuery.Rd create mode 100644 man/spatQueryGiottoPolygons.Rd diff --git a/.github/workflows/staging_branch_workflow.yml b/.github/workflows/staging_branch_workflow.yml index cc6b33f3..d45437c9 100644 --- a/.github/workflows/staging_branch_workflow.yml +++ b/.github/workflows/staging_branch_workflow.yml @@ -3,9 +3,6 @@ on: push: branches: [ staging ] - schedule: - - cron: '0 0 * * 1,4' # Run at midnight on Monday and Thursday - workflow_dispatch: # Allow manual trigger name: STAGING final checks @@ -43,7 +40,7 @@ jobs: if: runner.os == 'macOS' run: | brew install --cask xquartz - + - name: Install X11 on Ubuntu if: runner.os == 'Linux' run: | @@ -55,7 +52,7 @@ jobs: with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} - use-public-rspm: false + use-public-rspm: true - name: Set up dependencies (general) uses: r-lib/actions/setup-r-dependencies@v2 @@ -106,28 +103,21 @@ jobs: with: python-version: "3.10" - - name: report versions - shell: Rscript {0} - run: | - print(paste("terra:", packageVersion("terra"))) - print(paste("sf:", packageVersion("sf"))) - print(paste("SpatialExperiment:", packageVersion("SpatialExperiment"))) - - name: setup giotto_env shell: Rscript {0} run: | if (!GiottoClass::checkGiottoEnvironment()) { GiottoClass::installGiottoEnvironment() } - + reticulate::conda_install( envname = 'giotto_env', packages = 'scanpy', pip = TRUE ) - + path_to_python <- GiottoClass::set_giotto_python_path() - + writeLines(sprintf("RETICULATE_PYTHON=%s", path_to_python), Sys.getenv("GITHUB_ENV")) @@ -171,7 +161,7 @@ jobs: shell: Rscript {0} env: CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }} - + bioccheck: needs: R-CMD-check runs-on: ubuntu-latest diff --git a/DESCRIPTION b/DESCRIPTION index b757a095..514832bf 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,7 +26,7 @@ Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 Depends: - R (>= 4.4.1) + R (>= 4.4.0) Imports: checkmate, data.table (>= 1.12.2), @@ -110,13 +110,13 @@ Collate: 'methods-area.R' 'methods-centroids.R' 'methods-coerce.R' + 'methods-convHull.R' 'methods-copy.R' 'methods-crop.R' 'methods-dims.R' 'methods-ext.R' 'methods-extract.R' 'methods-flip.R' - 'methods-hull.R' 'methods-initialize.R' 'methods-instructions.R' 'methods-names.R' diff --git a/NAMESPACE b/NAMESPACE index 834bc214..2676bd0d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -59,7 +59,6 @@ export(combineMetadata) export(combineSpatialCellMetadataInfo) export(combineToMultiPolygon) export(compatible_spatial_network) -export(convHull) export(convertGiottoLargeImageToMG) export(convert_mgImage_to_array_DT) export(convert_to_full_spatial_network) @@ -176,8 +175,6 @@ export(list_spatial_networks_names) export(loadGiotto) export(makePseudoVisium) export(mean_flex) -export(minCircle) -export(minRect) export(my_arowMeans) export(my_growMeans) export(my_rowMeans) @@ -255,7 +252,6 @@ export(showNetworks) export(showProcessingSteps) export(sliceGiotto) export(smoothGiottoPolygons) -export(spatQuery) export(spatQueryGiottoPolygons) export(spatValues) export(spat_net_to_igraph) @@ -334,6 +330,7 @@ exportMethods(calculateOverlap) exportMethods(centroids) exportMethods(colnames) exportMethods(combineGeom) +exportMethods(convHull) exportMethods(copy) exportMethods(createGiottoPoints) exportMethods(createGiottoPolygon) @@ -348,9 +345,10 @@ exportMethods(featIDs) exportMethods(featType) exportMethods(flip) exportMethods(hist) -exportMethods(hull) exportMethods(instructions) exportMethods(intersect) +exportMethods(minCircle) +exportMethods(minRect) exportMethods(ncol) exportMethods(nrow) exportMethods(objName) @@ -403,19 +401,22 @@ importFrom(methods,validObject) importFrom(utils,.DollarNames) importMethodsFrom(Matrix,t) importMethodsFrom(terra,"ext<-") +importMethodsFrom(terra,area) importMethodsFrom(terra,as.data.frame) importMethodsFrom(terra,as.points) importMethodsFrom(terra,as.polygons) importMethodsFrom(terra,buffer) importMethodsFrom(terra,centroids) +importMethodsFrom(terra,convHull) importMethodsFrom(terra,crop) importMethodsFrom(terra,density) importMethodsFrom(terra,erase) importMethodsFrom(terra,ext) importMethodsFrom(terra,flip) importMethodsFrom(terra,hist) -importMethodsFrom(terra,hull) importMethodsFrom(terra,intersect) +importMethodsFrom(terra,minCircle) +importMethodsFrom(terra,minRect) importMethodsFrom(terra,ncol) importMethodsFrom(terra,nrow) importMethodsFrom(terra,plot) diff --git a/NEWS.md b/NEWS.md index c0a79d0b..21a042b7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,3 @@ - # GiottoClass 0.5.0 ## changes @@ -11,15 +10,11 @@ ## bug fixes - `overlaps()` will now properly find image overlaps - - -# GiottoClass 0.4.7 (2025/05/06) +# GiottoClass 0.4.7 (2025/02/04) ## new - `spatIDs()<-` for `giottoPolygon` - `combineGeom()` and `splitGeom()` for `giottoPolygon` -- `processData()` generic and `processParam` class -- `svkey` metaprogramming object for storing `spatValue()` parameters for later eval. ## bug fixes - fixes and updates for {spatialdata} and {anndata} interoperability. @@ -34,21 +29,10 @@ - fix `loadGiotto()` error when a non-expected reticulate environment is already activated in the session - fix `createGiottoLargeImage()` and `createGiottoPolygonsFromMask()` to align with {terra} `v1.8-21` `rast(noflip = TRUE)` [#1102](https://github.com/drieslab/Giotto/issues/1102) by StevenWijnen and rbutleriii - add fallback for when attributes do not match number of geometries in `createGiottoPolygon()` so that poly_ID col is not dropped -- fix `calculateOverlap()`when raster aggregation finds polygons with no values -- fix `createGiottoPolygon()` dispatch on `character` so that it can access poly cleanup params -- fix incorrect `giottoInstructions` class in older objects now possible via `updateGiottoObject()` -- Remove imports on deprecated {terra} `convHull()`, `minRect()`, `minCircle()`, in favor of `hull()` usage [#1153](https://github.com/drieslab/Giotto/issues/1153) by demographix -- Remove import on {terra} `area()`, define as new generic from {GiottoClass} -- fix `loadGiotto()` issue when there are multiple polygons and some only some of them have created centroids [#304](https://github.com/drieslab/GiottoClass/issues/304) -- fix `joinGiottoObjects` polygon joins when there is more than one set of polygons [#305](https://github.com/drieslab/GiottoClass/issues/305) ## changes -- `remove_background_poly` now defaults to `TRUE` during polygon ingestion - move {magick} from imports to suggests - {terra} `>=v1.8-21` -- deprecate `spatQueryGiottoPolygons()` in favor of more general `spatQuery()` -- deprecate `ometif_metadata()` in favor of `tif_metadata()` -- deprecate `ometif_to_tif()` in favor of `to_simple_tif()` ## enhancements - `[[` can now be used to select channels in `giottoLargeImage`-inheriting objects @@ -57,12 +41,10 @@ - `spatUnit()` and `featType()` method for `giotto` to find existing spatial units and feature types - expose `make_valid` param and `...` passing for `createGiottoPolygon()` `data.frame` method - `createGiottoPolygon()` `part_col` param for generating multipolygons from `data.frame-like` inputs. -- `combineCellData()` `ext`, `xlim`, `ylim` cropping. (also background poly removal in case of cropping artefacts) -- large improvements to anndata and spatialdata converters (see [#294](https://github.com/drieslab/GiottoClass/pull/294)) -- `spatLocsObj` can now be created from `numeric` xy pairs and xyz triplets -- improvements to `spatQuery()` -- add support for qptiff in `tif_metadata()` and `to_simple_tif()` +## new +- `processData()` generic and `processParam` class +- `svkey` metaprogramming object for storing `spatValue()` parameters for later eval. # GiottoClass 0.4.6 (2025/01/17) diff --git a/R/aggregate.R b/R/aggregate.R index 9a44744b..7eeec498 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -2082,8 +2082,7 @@ overlapToMatrixMultiPoly <- function(gobject, mat_c_names <- colnames(x) x[ match(mixedsort(mat_r_names), mat_r_names), - match(mixedsort(mat_c_names), mat_c_names), - drop = FALSE + match(mixedsort(mat_c_names), mat_c_names) ] } diff --git a/R/auxilliary.R b/R/auxilliary.R index 56692b95..25123de9 100644 --- a/R/auxilliary.R +++ b/R/auxilliary.R @@ -454,7 +454,24 @@ addCellMetadata <- function(gobject, ) - # 1. get the cell metadata to add to + # 1. check hierarchical slots + # Expression information must first exist in the gobject for the + # corresponding metadata information to be added. + avail_ex <- list_expression( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + if (is.null(avail_ex)) { + .gstop( + "No matching expression information discovered for: + spat_unit:", spat_unit, "\nfeature type:", feat_type, + "\nPlease add expression information first" + ) + } + + + # 2. get the cell metadata to add to cell_metadata <- getCellMetadata( gobject, spat_unit = spat_unit, @@ -467,7 +484,7 @@ addCellMetadata <- function(gobject, ordered_cell_IDs <- spatIDs(cell_metadata) - # 2. format input metadata + # 3. format input metadata # [vector/factor input] # Values are assumed to be in the same order as the existing metadata info. # Convert vector or factor into a single-column data.table @@ -506,7 +523,7 @@ addCellMetadata <- function(gobject, } - # 3. combine with existing metadata + # 4. combine with existing metadata # get old and new meta colnames that are not the ID col new_col_names <- colnames(new_metadata) new_col_names <- new_col_names[new_col_names != column_cell_ID] @@ -541,7 +558,7 @@ addCellMetadata <- function(gobject, } - # 4. ensure data is in same order as start and set data + # 5. ensure data is in same order as start and set data cell_metadata[] <- cell_metadata[][match(ordered_cell_IDs, cell_ID)] diff --git a/R/classes.R b/R/classes.R index 8d4fadfc..b24cb85c 100644 --- a/R/classes.R +++ b/R/classes.R @@ -321,7 +321,6 @@ setClass( #' @title Parameter Classes for Data Processing Operations #' @name processParam-class -#' @aliases processParam #' @description #' Utility class that defines a data processing procedure and any params used #' in performing it. Packages defining processing methods will create their own @@ -437,14 +436,6 @@ updateGiottoObject <- function(gobject) { gobject@h5_file <- NULL } - # ensure instructions are of correct type - inst <- instructions(gobject) - if (!inherits(inst, c("giottoInstructions", "NULL")) && - inherits(inst, "list")) { - class(inst) <- c("giottoInstructions", "list") - instructions(gobject, initialize = FALSE) <- inst - } - # [Switch to GiottoClass versioning] --------------------------------------# # GiottoClass 0.1.2 adds max_window and colors slots to giottoLargeImage # this update function has been moved to .update_image_slot() below diff --git a/R/combine_metadata.R b/R/combine_metadata.R index d089247e..53e220bd 100644 --- a/R/combine_metadata.R +++ b/R/combine_metadata.R @@ -167,9 +167,7 @@ combineSpatialCellMetadataInfo <- function(gobject, #' @title combineCellData #' @name combineCellData -#' @description Produce a table of information about the cells, including -#' the geometry and centroids information. This function will be simplified -#' in the future with [spatValues()]. +#' @description combine cell data information #' @param gobject giotto object #' @param feat_type feature type #' @param include_spat_locs include information about spatial locations @@ -178,13 +176,6 @@ combineSpatialCellMetadataInfo <- function(gobject, #' @param poly_info polygon information name #' @param include_spat_enr include information about spatial enrichment #' @param spat_enr_names names of spatial enrichment results to include -#' @param ext numeric or SpatExtent (optional). A cropping extent to apply to -#' to the geometries. -#' @param xlim,ylim numeric length of 2 (optional). x or y bounds to apply. -#' @param remove_background_polygon logical (default = `TRUE`). `crop()` may -#' sometimes produce extent-filling polygons when the original geometry is -#' problematic or invalid. Set `TRUE` to remove these, based on whether a -#' polygon fills up most of the x and y range. #' @concept combine cell metadata #' @returns data.table with combined spatial information #' @examples @@ -199,15 +190,7 @@ combineCellData <- function(gobject, include_poly_info = TRUE, poly_info = "cell", include_spat_enr = TRUE, - spat_enr_names = NULL, - ext = NULL, - xlim = NULL, - ylim = NULL, - remove_background_polygon = TRUE) { - - checkmate::assert_numeric(xlim, len = 2L, null.ok = TRUE) - checkmate::assert_numeric(ylim, len = 2L, null.ok = TRUE) - + spat_enr_names = NULL) { # combine # 1. spatial morphology information ( = polygon) # 2. cell metadata @@ -242,39 +225,13 @@ combineCellData <- function(gobject, ## spatial poly ## if (isTRUE(include_poly_info)) { # get spatial poly information - sv <- getPolygonInfo( + spatial_cell_info_spatvec <- getPolygonInfo( gobject = gobject, polygon_name = poly_info, return_giottoPolygon = FALSE ) - - e <- ext(sv) - need_crop <- FALSE - if (!is.null(xlim)) { - need_crop <- TRUE - e[c(1, 2)] <- xlim - } - if (!is.null(ylim)) { - need_crop <- TRUE - e[c(3, 4)] <- ylim - } - if (!is.null(ext)) { - need_crop <- TRUE - ext <- ext(ext) - e <- intersect(e, ext) - } - if (need_crop) { - sv <- crop(sv, e) - if (remove_background_polygon) { - sv <- .remove_background_polygon(sv, verbose = FALSE) - } - if (nrow(sv) == 0) { - warning("no geometries left after crop", call. = FALSE) - } - } - spatial_cell_info_dt <- data.table::as.data.table( - sv, + spatial_cell_info_spatvec, geom = "XY", include_values = TRUE ) @@ -286,6 +243,7 @@ combineCellData <- function(gobject, spatial_cell_info_dt <- NULL } + # combine spatloc and poly information if desired if (!is.null(spat_locs_dt) && !is.null(spatial_cell_info_dt)) { @@ -640,6 +598,10 @@ calculateSpatCellMetadataProportions <- function(gobject, ) data.table::setnames(x = proportions_mat, old = "source", new = "cell_ID") + # convert to matrix + # proportions_matrix = dt_to_matrix(proportions_mat) + # proportions_matrix[seq_len(4), seq_len(10)] + # create spatial enrichment object enrObj <- create_spat_enr_obj( name = name, diff --git a/R/create.R b/R/create.R index 2c324820..dcedfd24 100644 --- a/R/create.R +++ b/R/create.R @@ -2406,12 +2406,7 @@ NULL #' @export setMethod( "createGiottoPolygon", signature("character"), - function(x, - remove_background_polygon = TRUE, - background_algo = "range", - make_valid = FALSE, - verbose = TRUE, - ...) { + function(x, ...) { checkmate::assert_file_exists(x) # try success means it should be mask file @@ -2430,30 +2425,11 @@ setMethod( # mask workflow if (inherits(try_rast, "SpatRaster")) { - return(createGiottoPolygon(try_rast, - remove_background_polygon = remove_background_polygon, - background_algo = background_algo, - verbose = verbose, - ... - )) + return(createGiottoPolygon(try_rast, ...)) } # file workflow - reslist <- .evaluate_spatial_info(x, - make_valid = make_valid, - verbose = verbose - ) - - sv <- reslist$spatvector - - if (isTRUE(remove_background_polygon)) { - sv <- .remove_background_polygon(sv, - background_algo = background_algo, - verbose = verbose - ) - } - - createGiottoPolygon(sv, ...) + return(createGiottoPolygon(x = terra::vect(x), ...)) } ) @@ -2562,7 +2538,7 @@ setMethod( #' @param mask_method how the mask file defines individual segmentation #' annotations. See *mask_method* section #' @param remove_background_polygon try to remove background -#' polygon (default: TRUE) +#' polygon (default: FALSE) #' @param background_algo algorithm to remove background polygon #' @param fill_holes fill holes within created polygons #' @param poly_IDs character vector. Default = NULL. Custom unique names for @@ -2605,7 +2581,7 @@ createGiottoPolygonsFromMask <- function( maskfile, mask_method = c("guess", "single", "multiple"), name = "cell", - remove_background_polygon = TRUE, + remove_background_polygon = FALSE, background_algo = c("range"), fill_holes = TRUE, poly_IDs = NULL, @@ -2760,10 +2736,26 @@ createGiottoPolygonsFromMask <- function( ## remove background polygon ## if (isTRUE(remove_background_polygon)) { - terra_polygon <- .remove_background_polygon(terra_polygon, - background_algo = background_algo, - verbose = verbose - ) + if (background_algo == "range") { + backgr_poly_id <- .identify_background_range_polygons( + terra_polygon + ) + if (length(backgr_poly_id) > 1L) { + warning("More than one background poly found.") + } + } + + if (length(backgr_poly_id) > 0) { + vmsg(.v = verbose, sprintf( + "removed background poly.\n ID was: %s", + backgr_poly_id + )) + + terra_polygon <- terra::subset( + x = terra_polygon, + terra_polygon[["poly_ID"]] != backgr_poly_id + ) + } } @@ -2885,8 +2877,6 @@ createGiottoPolygonsFromGeoJSON <- function(GeoJSON, name = "cell", calc_centroids = FALSE, make_valid = FALSE, - remove_background_polygon = TRUE, - background_algo = "range", verbose = TRUE) { eval_list <- .evaluate_spatial_info( spatial_info = GeoJSON, @@ -2897,14 +2887,6 @@ createGiottoPolygonsFromGeoJSON <- function(GeoJSON, spatvector <- eval_list$spatvector unique_IDs <- eval_list$unique_IDs - ## remove background polygon ## - if (isTRUE(remove_background_polygon)) { - spatvector <- .remove_background_polygon(spatvector, - background_algo = background_algo, - verbose = verbose - ) - } - g_polygon <- create_giotto_polygon_object( name = name, spatVector = spatvector, @@ -2928,30 +2910,7 @@ createGiottoPolygonsFromGeoJSON <- function(GeoJSON, -.remove_background_polygon <- function(x, - background_algo = "range", - verbose = NULL) { - ## remove background polygon ## - if (background_algo == "range") { - backgr_poly_id <- .identify_background_range_polygons(x) - if (length(backgr_poly_id) > 1L) { - warning("More than one background poly found.") - } - } - - if (length(backgr_poly_id) > 0) { - vmsg(.v = verbose, sprintf( - "removed background poly.\n ID was: %s", - backgr_poly_id - )) - x <- terra::subset( - x = x, - x[["poly_ID"]] != backgr_poly_id - ) - } - x -} #' @title Create a giotto polygon object diff --git a/R/data_evaluation.R b/R/data_evaluation.R index ba494782..69947ede 100644 --- a/R/data_evaluation.R +++ b/R/data_evaluation.R @@ -112,7 +112,7 @@ evaluate_input <- function(type, x, ...) { } else if (target_class == "dbMatrix") { .gstop( "Automatic conversion to 'dbMatrix' is not supported within ", - "createExprObj(). Please provide a pre-constructed ", + "createExprObj(). Please provide a pre‑constructed ", "'dbMatrix' object instead. See ?dbMatrix for details." ) } else if (target_class == "DelayedArray") { diff --git a/R/generics.R b/R/generics.R index 1ef50be3..949d141b 100644 --- a/R/generics.R +++ b/R/generics.R @@ -111,8 +111,9 @@ setGeneric("XY<-", function(x, ..., value) standardGeneric("XY<-")) setGeneric("settleGeom", function(x, ...) standardGeneric("settleGeom")) setGeneric("combineGeom", function(x, ...) standardGeneric("combineGeom")) setGeneric("splitGeom", function(x, ...) standardGeneric("splitGeom")) -setGeneric("area", function(x, ...) standardGeneric("area")) - +if (!isGeneric("area")) { + setGeneric("area", function(x, ...) standardGeneric("area")) +} # Methods and documentations found in methods-overlaps.R setGeneric("overlaps", function(x, ...) standardGeneric("overlaps")) diff --git a/R/images.R b/R/images.R index 4934a3cb..d71ca77a 100644 --- a/R/images.R +++ b/R/images.R @@ -709,12 +709,12 @@ reconnect_giottoImage_MG <- function( #' @keywords internal .spatraster_sample_values <- function(raster_object, size = 5000, - output = c("data.frame", "array", "magick", "EBImage", "SpatRaster"), + output = c("data.frame", "array", "magick", "EBImage"), verbose = NULL, ...) { output <- match.arg( arg = output, - choices = c("data.frame", "array", "magick", "EBImage", "SpatRaster") + choices = c("data.frame", "array", "magick", "EBImage") ) # account for possible giottoLargeImage input @@ -744,7 +744,6 @@ reconnect_giottoImage_MG <- function( if (isTRUE(argslist$as.df)) { res <- stats::na.omit(res) # data.frame remove NAs } else { - if (output == "SpatRaster") return(res) # all others res <- terra::as.array(res) na_bool <- is.na(res) diff --git a/R/interoperability.R b/R/interoperability.R index b7249647..1ec5c3f5 100644 --- a/R/interoperability.R +++ b/R/interoperability.R @@ -203,23 +203,18 @@ check_py_for_scanpy <- function() { #' @param n_key_added equivalent of "key_added" argument from scanpy.pp. #' neighbors(). If multiple spatial networks are in the anndata object, a list #' of key_added terms may be provided. If converting an anndata object from -#' giottoToAnnData, the keys are saved in `.uns['NN_keys']` -#' and all keys are used in conversion unless specified in the function call. -#' Cannot be "spatial". This becomes the name of the nearest network in the gobject. +#' giottoToAnnData, a .txt file may be provided, which was generated in that +#' function, i.e. \{spat_unit\}_\{feat_type\}_nn_network_keys_added.txt. Cannot +#' be "spatial". This becomes the name of the nearest network in the gobject. #' @param spatial_n_key_added equivalent of "key_added" argument from #' squidpy.gr.spatial_neighbors. If multiple spatial networks are in the #' anndata object, a list of key_added terms may be provided. If converting an -#' anndata object from giottoToAnnData, the keys are saved in `.uns['SN_keys']` -#' and all keys are used in conversion unless specified in the function call. +#' anndata object from giottoToAnnData, a .txt file may be provided, which was +#' generated in that function, +#' i.e. \{spat_unit\}_\{feat_type\}_spatial_network_keys_added.txt #' Cannot be the same as n_key_added. #' @param delaunay_spat_net binary parameter for spatial network. If TRUE, the #' spatial network is a delaunay network. -#' @param spat_enrich_key_added -#' list of names of spatial enrichment annotations present in the anndata object. -#' If converting an anndata object from giottoToAnnData and the original Giotto object had -#' spatial enrichment annotations, the keys are saved in -#' `.uns['SE_keys']` -#' and all keys are used in conversion unless specified in the function call. #' @param spat_unit desired spatial unit to use for conversion, default NULL #' @param feat_type desired feature type to use for conversion, default NULL #' @param h5_file name to create and on-disk HDF5 file @@ -1157,7 +1152,7 @@ giottoToAnnData <- function(gobject = NULL, # Save SN keys to .uns['SN_keys'] if (length(network_name) != 0) { - save_SN_keys(adata = adata_list[[adata_pos]], + save_SN_keys(adata = adata_list[[adata_pos]], network_name = network_name) } } @@ -1169,9 +1164,9 @@ giottoToAnnData <- function(gobject = NULL, adata_pos <- 1 # Spatial Enrichment - spat_enrich_list <- list_giotto_data(gobject = gobject, + spat_enrich_list <- list_giotto_data(gobject = gobject, slot = "spatial_enrichment") - + if (!is.null(spat_enrich_list) && is.data.frame(spat_enrich_list)) { for (i in seq_len(nrow(spat_enrich_list))) { se_su <- spat_enrich_list[i]$spat_unit @@ -1191,7 +1186,7 @@ giottoToAnnData <- function(gobject = NULL, name = se_name ) } - save_SE_keys(adata = adata_list[[adata_pos]], + save_SE_keys(adata = adata_list[[adata_pos]], enrichment_name = spat_enrich_list$name) } @@ -3496,23 +3491,20 @@ giottoMasterToSuite <- function(gobject, #' @param n_key_added equivalent of "key_added" argument from scanpy.pp.neighbors(). #' If multiple spatial networks are in the anndata object, a list of key_added #' terms may be provided. -#' If converting an anndata object from giottoToAnnData, the keys are saved in `.uns['NN_keys']` -#' and all keys are used in conversion unless specified in the function call. +#' If converting an anndata object from giottoToAnnData, a .txt file may be +#' provided, which was generated in that function, +#' i.e. \{spat_unit\}_\{feat_type\}_nn_network_keys_added.txt #' Cannot be "spatial". This becomes the name of the nearest network in the gobject. #' @param spatial_n_key_added #' equivalent of "key_added" argument from squidpy.gr.spatial_neighbors. #' If multiple spatial networks are in the anndata object, a list of key_added #' terms may be provided. -#' If converting a SpatialData object from giottoToSpatialData, the keys are saved in `.uns['SN_keys']` -#' and all keys are used in conversion unless specified in the function call. +#' If converting an anndata object from giottoToAnnData, a .txt file may be +#' provided, which was generated in that function, +#' i.e. \{spat_unit\}_\{feat_type\}_spatial_network_keys_added.txt #' Cannot be the same as n_key_added. #' @param delaunay_spat_net binary parameter for spatial network. If TRUE, #' the spatial network is a delaunay network. -#' @param spat_enrich_key_added -#' list of names of spatial enrichment annotations added to the SpatialData object. -#' If converting an anndata object from giottoToAnnData and the original Giotto object had -#' spatial enrichment annotations, the keys are saved in `.uns['SE_keys']` -#' and all keys are used in conversion unless specified in the function call. #' @param spat_unit desired spatial unit for conversion, default NULL #' @param feat_type desired feature type for conversion, default NULL #' @param python_path path to python executable within a conda/miniconda environment @@ -3622,7 +3614,7 @@ spatialdataToGiotto <- function( } ft_list <- c(ft_list, ft) cat("Spatial unit and feature type extracted from table name.\n") - } + } else if (length(su_list_initial) > 0 && length(ft_list_initial) == 0) { su <- spat_unit ft <- "rna" @@ -3647,11 +3639,11 @@ spatialdataToGiotto <- function( ft_list <- c(ft_list, ft) cat("Default spatial unit and feature type have been set to [cell][rna]. If you wish to set a specific\nspatial unit and feature type, please specify it in the function call.\n") } - + gobject <- setExpression( - gobject, - x = createExprObj(expr_df_dict[[key]], name = "raw"), - spat_unit = su, + gobject, + x = createExprObj(expr_df_dict[[key]], name = "raw"), + spat_unit = su, feat_type = ft) } @@ -3735,13 +3727,13 @@ spatialdataToGiotto <- function( parts <- strsplit(key, "_")[[1]] spat_loc_su <- parts[1] gobject <- setSpatialLocations( - gobject, - x = createSpatLocsObj(spatial_dict[[key]], name = "raw"), + gobject, + x = createSpatLocsObj(spatial_dict[[key]], name = "raw"), spat_unit = spat_loc_su) } else { gobject <- setSpatialLocations( - gobject, - x = createSpatLocsObj(spatial_dict[[key]], name = "raw"), + gobject, + x = createSpatLocsObj(spatial_dict[[key]], name = "raw"), spat_unit = su) } } @@ -3810,7 +3802,7 @@ spatialdataToGiotto <- function( sk <- gsub("[()']", "", split_key[2]) s_distances_sd <- extract_SN_distances( - sdata, key_added = spatial_n_key_added_it, + sdata, key_added = spatial_n_key_added_it, tn = tn, sn_key_list = sk) ij_matrix <- methods::as(s_distances_sd, "TsparseMatrix") from_idx <- ij_matrix@i + 1 # zero index!!! @@ -3891,7 +3883,7 @@ spatialdataToGiotto <- function( ## Add PCA p_dict <- extract_pca(sdata) if (!is.null(p_dict)) { - for (tn in names(p_dict)) { + for (tn in names(p_dict)) { for (i in seq_along(p_dict[[tn]][[1]])) { p <- p_dict[[tn]][[1]][[i]] if (!is.null(p)) { @@ -3918,7 +3910,7 @@ spatialdataToGiotto <- function( my_rownames = rownames_vec ) gobject <- set_dimReduction( - gobject = gobject, + gobject = gobject, dimObject = dobj) } } @@ -3949,7 +3941,7 @@ spatialdataToGiotto <- function( my_rownames = rownames_vec ) gobject <- set_dimReduction( - gobject = gobject, + gobject = gobject, dimObject = dobj) } } @@ -4010,7 +4002,7 @@ spatialdataToGiotto <- function( nk <- gsub("[()']", "", split_key[2]) distances_sd <- extract_NN_distances( - sdata, key_added = n_key_added_it, + sdata, key_added = n_key_added_it, tn = tn, nn_key_list = nk) nn_dt <- align_network_data( @@ -4029,7 +4021,7 @@ spatialdataToGiotto <- function( nn_dt[, uniq_ID := NULL] vert <- unique(x = c(nn_dt$from_cell_ID, nn_dt$to_cell_ID)) nn_network_igraph <- igraph::graph_from_data_frame( - nn_dt[, .(from_cell_ID, to_cell_ID, weight, distance)], + nn_dt[, .(from_cell_ID, to_cell_ID, weight, distance)], directed = TRUE, vertices = vert) nn_info <- extract_NN_info( @@ -4105,13 +4097,13 @@ spatialdataToGiotto <- function( #' @param spat_unit spatial unit which will be used in conversion #' @param feat_type feature type which will be used in conversion #' @param spot_radius radius of the spots -#' @param python_path path to python executable within a conda/miniconda +#' @param python_path path to python executable within a conda/miniconda #' environment #' @param env_name name of environment containing python_path executable #' @param save_directory directory in which the SpatialData object will be saved #' #' @return SpatialData object saved on disk. -#' @details Function in beta. Converts and saves a Giotto object in SpatialData +#' @details Function in beta. Converts and saves a Giotto object in SpatialData #' format on disk. #' @export @@ -4196,7 +4188,7 @@ giottoToSpatialData <- function(gobject = NULL, for (su in spat_unit) { gpoly <- getPolygonInfo(gobject, polygon_name = su) gpoly_sf <- as.sf(gpoly) - sf::st_write(gpoly_sf, paste0(temp, "shapes/", su, ".geojson"), + sf::st_write(gpoly_sf, paste0(temp, "shapes/", su, ".geojson"), delete_dsn = TRUE) } } @@ -4207,7 +4199,7 @@ giottoToSpatialData <- function(gobject = NULL, for (ft in feat_type) { gpoint <- getFeatureInfo(gobject, feat_type = ft) gpoint_dt <- as.data.table(gpoint, geom = "XY") - fwrite(gpoint_dt, paste0(temp, "points/", ft, ".csv"), + fwrite(gpoint_dt, paste0(temp, "points/", ft, ".csv"), sep = ",", row.names = FALSE) } } diff --git a/R/join.R b/R/join.R index afd35295..c8cc827e 100644 --- a/R/join.R +++ b/R/join.R @@ -691,7 +691,6 @@ joinGiottoObjects <- function(gobject_list, for (gobj_i in seq_along(updated_object_list)) { gpoly <- getPolygonInfo( updated_object_list[[gobj_i]], - polygon_name = spat_info, return_giottoPolygon = TRUE ) spat_information_vector <- gpoly[] diff --git a/R/methods-area.R b/R/methods-area.R index 04104821..17a49905 100644 --- a/R/methods-area.R +++ b/R/methods-area.R @@ -1,16 +1,9 @@ # docs ----------------------------------------------------------- # #' @title Get the area of individual polygons #' @name area -#' @aliases area #' @description Compute the area covered by polygons -#' @details -#' Giotto's methods do not hook into terra's `area()` generic. This is because -#' `area()` in terra is deprecated in favor of `expanse()`. Additionally, -#' Giotto suppresses warnings about unrecognized CRS, which are currently not -#' as relevant for biological data. -#' #' @param x `giottoPolygon` -#' @inheritDotParams terra::expanse +#' @param ... additional args to pass #' @returns `numeric` vector of spatial area #' @examples #' sl <- GiottoData::loadSubObjectMini("spatLocsObj") @@ -18,12 +11,12 @@ #' gpoints <- GiottoData::loadSubObjectMini("giottoPoints") #' #' # area of polygons -#' head(area(gpoly)) +#' area(gpoly) #' #' # area of the convex hull -#' area(hull(sl)) -#' feature_hulls <- hull(gpoints, by = "feat_ID") -#' head(area(feature_hulls)) +#' area(convHull(sl)) +#' feature_hulls <- convHull(gpoints, by = "feat_ID") +#' area(feature_hulls) #' NULL # ---------------------------------------------------------------- # @@ -31,16 +24,13 @@ NULL #' @rdname area #' @export setMethod("area", signature("giottoPolygon"), function(x, ...) { - area(x[], ...) + # handle warning about missing CRS + handle_warnings(area(x[], ...))$result }) #' @rdname area #' @export setMethod("area", signature("SpatVector"), function(x, ...) { - area_params <- list(x, ...) - area_params$transform <- area_params$transform %null% FALSE # handle warning about missing CRS - handle_warnings({ - do.call(terra::expanse, args = area_params) - })$result + handle_warnings(terra::expanse(x, transform = FALSE, ...))$result }) diff --git a/R/methods-convHull.R b/R/methods-convHull.R new file mode 100644 index 00000000..30f20472 --- /dev/null +++ b/R/methods-convHull.R @@ -0,0 +1,60 @@ +# docs ----------------------------------------------------------- # +#' @title Convex hull, minimal bounding rotated rectangle, and minimal bounding circle +#' @name convHull +#' @aliases minRect minCircle +#' @description Get the convex hull, the minimal bounding rotated rectangle, +#' or minimal bounding circle of a Giotto spatial object or terra SpatVector +#' @param x any of giotto image, giottoPolygon, giottoPoints, spatLocsObj, SpatVector +#' @param by character (variable name), to get a new geometry for groups of input geometries +#' @param \dots additional parameters to pass +#' @examples +#' sl <- GiottoData::loadSubObjectMini("spatLocsObj") +#' gpoints <- GiottoData::loadSubObjectMini("giottoPoints") +#' +#' h <- convHull(sl) +#' plot(h) +#' +#' r <- minRect(sl) +#' plot(r) +#' +#' circ <- minCircle(gpoints, by = "feat_ID") +#' plot(circ, border = rainbow(100)) +#' +#' @returns SpatVector +NULL +# ---------------------------------------------------------------- # + +#' @rdname convHull +#' @export +setMethod("convHull", signature("spatLocsObj"), function(x, by = "", ...) { + convHull(x = as.points(x), by = by, ...) +}) +#' @rdname convHull +#' @export +setMethod("convHull", signature("giottoSpatial"), function(x, by = "", ...) { + convHull(x[], by = by, ...) +}) + + +#' @rdname convHull +#' @export +setMethod("minRect", signature("spatLocsObj"), function(x, by = "", ...) { + minRect(x = as.points(x), by = by, ...) +}) +#' @rdname convHull +#' @export +setMethod("minRect", signature("giottoSpatial"), function(x, by = "", ...) { + minRect(x[], by = by, ...) +}) + + +#' @rdname convHull +#' @export +setMethod("minCircle", signature("spatLocsObj"), function(x, by = "", ...) { + minCircle(x = as.points(x), by = by, ...) +}) +#' @rdname convHull +#' @export +setMethod("minCircle", signature("giottoSpatial"), function(x, by = "", ...) { + minCircle(x[], by = by, ...) +}) diff --git a/R/methods-hull.R b/R/methods-hull.R deleted file mode 100644 index aa4d220d..00000000 --- a/R/methods-hull.R +++ /dev/null @@ -1,77 +0,0 @@ -# docs ----------------------------------------------------------- # -#' @title Convex, concave, rectangular and circular hulls -#' @name hull -#' @aliases minRect minCircle convHull -#' @description Compute a hull around Giotto spatial object or terra SpatVector. -#' The concaveness of the concave hull can be specified in different ways. -#' @param x any of giotto image, giottoPolygon, giottoPoints, spatLocsObj, SpatVector -#' @param by character (variable name), to get a new geometry for groups of input geometries -#' @inheritParams terra::hull -#' @inheritDotParams terra::hull -#' @examples -#' sl <- GiottoData::loadSubObjectMini("spatLocsObj") -#' gpoints <- GiottoData::loadSubObjectMini("giottoPoints") -#' -#' h <- hull(sl) -#' plot(h) -#' -#' r <- hull(sl, type = "rectangle") -#' plot(r) -#' -#' circ <- hull(gpoints, type = "circle", by = "feat_ID") -#' plot(circ, border = rainbow(100)) -#' -#' plot(hull(sl, type = "concave_ratio", param = 0.15, allowHoles = FALSE)) -#' -#' @returns SpatVector -NULL -# ---------------------------------------------------------------- # - -#' @rdname hull -#' @export -setMethod("hull", signature("spatLocsObj"), function(x, by = "", param = 1, allowHoles = TRUE, tight = TRUE, ...) { - hull( - x = as.points(x), - by = by, - param = param, - allowHoles = allowHoles, - tight = tight, - ... - ) -}) -#' @rdname hull -#' @export -setMethod("hull", signature("giottoSpatial"), function(x, by = "", param = 1, allowHoles = TRUE, tight = TRUE, ...) { - hull( - x = x[], - by = by, - param = param, - allowHoles = allowHoles, - tight = tight, - ... - ) -}) - -#' @rdname hull -#' @export -minRect <- function(x, ...) { - warning("minRect() is deprecated. Please use hull() in the future.", - call. = FALSE) - hull(x, type = "rectangle", ...) -} - -#' @rdname hull -#' @export -minCircle <- function(x, ...) { - warning("minCircle() is deprecated. Please use hull() in the future.", - call. = FALSE) - hull(x, type = "circle", ...) -} - -#' @rdname hull -#' @export -convHull <- function(x, ...) { - warning("convHull() is deprecated. Please use hull() in the future.", - call. = FALSE) - hull(x, type = "convex", ...) -} diff --git a/R/methods-initialize.R b/R/methods-initialize.R index 4b7386bb..9894f811 100644 --- a/R/methods-initialize.R +++ b/R/methods-initialize.R @@ -387,7 +387,7 @@ setMethod("initialize", signature("giottoAffineImage"), function(.Object, ...) { # detect ID slots avail_cid <- list_cell_id_names(.Object) - avail_fid <- list_feat_id_names(.Object) + avail_fid <- list_cell_id_names(.Object) # detect metadata slots avail_cm <- list_cell_metadata(.Object) diff --git a/R/package_imports.R b/R/package_imports.R index 367978ce..782d4133 100644 --- a/R/package_imports.R +++ b/R/package_imports.R @@ -12,7 +12,7 @@ #' @importFrom graphics legend par rect #' @importMethodsFrom terra spin flip rescale t #' @importMethodsFrom Matrix t -#' @importMethodsFrom terra ext ext<- hull +#' @importMethodsFrom terra ext ext<- convHull minCircle minRect #' @importMethodsFrom terra plot #' @importMethodsFrom terra wrap #' @importMethodsFrom terra zoom @@ -23,6 +23,7 @@ #' @importMethodsFrom terra as.data.frame as.polygons as.points #' @importMethodsFrom terra nrow ncol #' @importMethodsFrom terra hist density +#' @importMethodsFrom terra area #' @importClassesFrom terra SpatExtent SpatVector #' @import GiottoUtils #' @import data.table diff --git a/R/save_load.R b/R/save_load.R index 1c6ca423..862ab5d4 100644 --- a/R/save_load.R +++ b/R/save_load.R @@ -568,10 +568,7 @@ loadGiotto <- function(path_to_folder, # these files are optional, depending on if they have been calculated. # They may not exist - # build expected filenames as file search terms shp_search <- paste0(spats, "_spatInfo_spatVectorCentroids.shp") - txt_search <- paste0(spats, "_spatInfo_spatVectorCentroids_names.txt") - # detect existing centroids files shp_files <- basenames[basenames %in% shp_search] # return early if none exist @@ -579,36 +576,30 @@ loadGiotto <- function(path_to_folder, return(gobject) } - # apply name on search terms for simple and unique indexing - names(shp_search) <- names(txt_search) <- spats + txt_files <- paste0(spats, "_spatInfo_spatVectorCentroids_names.txt") - # iterate through spat_units for data load - # skip the spat_unit if file not found + # ordering of files follow spats + # apply name for simple and unique indexing + names(shp_files) <- names(txt_files) <- spats + + # iterate through spat_units and load/regen then append the data + # to the gobject for (spat in spats) { - load_shp <- manifest[[shp_search[[spat]]]] - load_txt <- manifest[[txt_search[[spat]]]] + load_shp <- manifest[[shp_files[[spat]]]] + load_txt <- manifest[[txt_files[[spat]]]] if (is.null(load_shp)) next # skip to next spat_unit if none vmsg( .v = verbose, .is_debug = TRUE, .initial = " ", sprintf("[%s] %s", spat, basename(load_shp)) ) - missing_nametxt <- FALSE - if (is.null(load_txt)) { - warning(sprintf("[%s] missing centroid attribute names.txt", spat), - call. = FALSE) - missing_nametxt <- TRUE - } - - # read in centroids spatVector <- terra::vect(load_shp) + # read in original column names and assign to spatVector - if (!missing_nametxt) { - spatVector_names <- data.table::fread( - input = load_txt, header = FALSE - )[["V1"]] - names(spatVector) <- spatVector_names - } + spatVector_names <- data.table::fread( + input = load_txt, header = FALSE + )[["V1"]] + names(spatVector) <- spatVector_names gobject@spatial_info[[spat]]@spatVectorCentroids <- spatVector } diff --git a/R/slot_accessors.R b/R/slot_accessors.R index a074a252..7e03a9be 100644 --- a/R/slot_accessors.R +++ b/R/slot_accessors.R @@ -4995,7 +4995,7 @@ setFeatureInfo <- function(gobject, # NATIVE INPUT TYPES # 2. if input is giottoPoints or NULL, pass to internal - if (is.null(x) || inherits(x, "giottoPoints")) { + if (is.null(x) | inherits(x, "giottoPoints")) { # pass to internal gobject <- set_feature_info( gobject = gobject, diff --git a/R/spatial_query.R b/R/spatial_query.R index 62e9f19f..93dee4a1 100644 --- a/R/spatial_query.R +++ b/R/spatial_query.R @@ -1,453 +1,136 @@ ## * spatial queries #### - # If the polys are to be clipped, then the returned info MUST be a new polygon # object -#' @title Spatial Query -#' @name spatQuery -#' @description Select spatial geometries based on a list of spatial `filters`. -#' The final item in provided in the list is the layer of information -#' being queried.\cr -#' By default, results will be returned as a new polygon-based spatial unit -#' with selection information recorded in the associated cell metadata. \cr -#' Spatial queries may perform queries on the geometries themselves, so -#' `intersect()` operations are performed under the hood. For a lighter weight -#' option that just finds spatial relationships, see [relate()] -#' @param gobject `giotto` object -#' @param filters named list of characters and/or `giottoPolygons` to use as -#' spatial filters for the final item in the list. -#' -#' * \[`character`\] list name designates the gobject spatial unit to use as a -#' filter. The actual character values should either be `"all"` or a specific -#' vector of cell_IDs to use. -#' * \[`giottoPolygon`\] inputs are directly used as filters. List names are -#' used when reporting the spatial relationships in output geometry objects. -#' These can also be used as centroids and additionally can be buffered. -#' * \[`SpatVector`] inputs are directly used. Can also be converted to -#' centroids and/or buffered. -#' * \[`numeric`\] input is read as XY pairs (e.g. `c(x1, y1, x2, y2, ...)`), -#' to be used as centroids. These are bufferable. -#' * \['spatLocsObj'\] inputs are directly used as centroids. These are -#' bufferable. -#' @param name (optional) character. If not `NULL`, a new spatial unit of this -#' name will be generated from the results. -#' @param clip logical. Default = `TRUE`. Whether final round of querying should -#' produce polygons clipped by the polygons used to select them. -#' @param use_centroids character vector. Values must correspond to names in -#' `filters`. Selected `filters` will be converted to centroids. (prefers -#' usage of the first set of spatlocs for that spat_unit) -#' @param buffer numeric. Or named vector of numerics. Names must correspond to -#' those in `centroids`. Applies the specified buffer to the centroid to allow -#' it to be used in `filter`. A `0` will skip buffering, but this is only -#' permitted if is also the the last item in `filter`. Unbuffered points may -#' only return results as IDs (`return_ids = TRUE`). Do note that buffering on -#' a large number of elements can cause significant slowdowns. -#' @param make_valid logical (default = `FALSE`). Whether to make geometries -#' valid before using them. Set `TRUE` if topology errors show up. -#' @param combine_fragments logical. (default = `FALSE`). Whether to combine -#' geoms fragmented by the intersections as multipolygons based on the -#' `poly_ID` col. If `TRUE`, the operation may introduce `NA`s in the spatial -#' relationship information. -#' @param dissolve logical. (default = `FALSE`). If `combine_fragments = TRUE`, -#' whether to also merge the multipolygon into a single polygon. -#' @param return_table logical. (Default = `FALSE`) Overrides `return__object`. -#' If `TRUE`, return only the relationships as a `data.table` -#' @param return_ids logical. (Default = `FALSE`) Overrides `return_gobject`. -#' If `TRUE`, return only the poly_IDs of the final entry in `filters` -#' @param return_gobject logical. (Default = `TRUE)`. Whether to return the new -#' set of polygons attached to the giotto object. -#' @param verbose verbosity -#' @returns `character` (IDs), `giottoPolygon`, or `giotto` depending on -#' `return_ids` and `return_gobject`. -#' @examples -#' g <- GiottoData::loadGiottoMini("vizgen") -#' pz0 <- getPolygonInfo(g, "z0") -#' boxgrid <- tessellate( -#' extent = ext(g), -#' shape = "square", -#' shape_size = 50, -#' name = "boxgrid" -#' ) -#' hexarray <- tessellate( -#' extent = ext(g), -#' shape = "hexagon", -#' shape_size = 80, -#' name = "hexarray" -#' ) -#' g <- setGiotto(g, boxgrid) -#' g <- setGiotto(g, hexarray) -#' -#' hex_ids <- sprintf("ID_%d", c(1, 3, 6, 8, 17, 19, 23)) -#' box_ids <- sprintf("ID_%d", c(12, 14, 15, 16, 22, 41, 44, 45, 51, 52, 62)) -#' -#' g <- spatQuery(g, -#' filters = list( -#' hexarray = hex_ids, -#' boxgrid = box_ids, -#' z0 = "all" -#' ), -#' return_gobject = TRUE -#' ) -#' # extract polys since we attached it to the giotto object -#' qp <- g[[, "query_polys"]][[1]] -#' -#' qp2 <- spatQuery(g, -#' filters = list( -#' hexarray = hex_ids[3], -#' boxgrid = box_ids, -#' z0 = "all" -#' ), -#' buffer = c(hexarray = 150), -#' return_gobject = FALSE -#' ) -#' -#' # check that extracted polys are being clipped as expected -#' plot(pz0) -#' plot(hexarray[hex_ids], border = "blue", add = TRUE) -#' plot(boxgrid[box_ids], add = TRUE, border = "red") -#' plot(qp, col = rainbow(20), add = TRUE) # selection by hex and box -#' plot(buffer(hexarray[hex_ids[3]], width = 150), add = TRUE) # buffered hex -#' plot(qp2, col = "black", add = TRUE) # selection by buffered hex and box -#' -#' # query for polys that fall within 100 units of a point -#' res <- spatQuery(g, -#' filters = list( -#' pts = c(6500, -4900), -#' z0 = "all" -#' ), -#' buffer = c(pts = 100), -#' return_gobject = FALSE, -#' make_valid = TRUE, -#' clip = FALSE -#' ) -#' -#' pt_buffer <- buffer( -#' as.points(createSpatLocsObj(c(6500, -4900))), -#' 100 -#' ) -#' -#' plot(pz0) -#' plot(pt_buffer, add = TRUE, border = "dodgerblue") # the selecting shape. -#' # note that clip = FALSE for this selection -#' plot(res, col = "red", add = TRUE) -#' -#' # only return the ids -#' ids <- spatQuery(g, -#' filters = list( -#' pts = c(6500, -4900), -#' z0 = "all" -#' ), -#' buffer = c(pts = 100), -#' return_ids = TRUE, -#' make_valid = TRUE -#' ) -#' head(ids) -#' length(ids) -#' -#' # only return the table of relations -#' tab <- spatQuery(g, -#' filters = list( -#' hexarray = hex_ids, -#' boxgrid = box_ids, -#' z0 = "all" -#' ), -#' return_table = TRUE, -#' make_valid = TRUE -#' ) -#' force(tab) -#' +#' @title Spatially query polygons within Giotto object +#' @name spatQueryGiottoPolygons +#' @description Recursively select polygons based on a list of spatial filters. +#' Results will be returned as a new polygon-based spatial unit with selection +#' information recorded in the associated cell metadata. The final item in +#' provided in param \code{filters} is the layer of information being queried. +#' @param gobject Giotto object +#' @param filters list of characters. Named list of IDs to query on as spatial +#' filters where the names designate the spatial unit to use and the character +#' values should either be 'all' or a vector of cell_IDs to use. +#' @param name (optional) character. If not NULL, a new spatial unit of this +#' name will be generated from the results +#' @param feat_type (optional) May be changed in future. Determines which +#' feature type metadata in which hierarchical selection information is stored. +#' @param clip boolean. Default = FALSE. Whether final round of querying should +#' return polygons clipped by the polygons used to select them. If TRUE, a value +#' must be provided to \code{name} param to generate a new spatial unit +#' @returns giottoPolygon #' @seealso [relate()] #' @export -spatQuery <- function(gobject, +spatQueryGiottoPolygons <- function(gobject, filters, name = "query_polys", - clip = TRUE, - use_centroids = NULL, - buffer = 0, - make_valid = FALSE, - combine_fragments = FALSE, - dissolve = FALSE, - return_table = FALSE, - return_ids = FALSE, - return_gobject = TRUE, - verbose = NULL) { - # input type validation -------------------------------------------- # - if (!missing(gobject)) assert_giotto(gobject) + feat_type = NULL, + clip = TRUE) { + assert_giotto(gobject) if (!is.null(name)) checkmate::assert_character(name) - checkmate::assert_list(filters, - types = c("character", "giottoPolygon", "spatLocsObj", "numeric", - "integer", "SpatVector") - ) - checkmate::assert_character(use_centroids, null.ok = TRUE) - checkmate::assert_numeric(buffer) - checkmate::assert_character(name) - checkmate::assert_logical(clip) - checkmate::assert_logical(return_ids) - checkmate::assert_logical(combine_fragments) - checkmate::assert_logical(return_gobject) - - # more specific checks on inputs ----------------------------------- # - if (length(filters) < 2L) { - stop(wrap_txt("At least two elements in filters are needed."), - call. = FALSE) - } - # `filters` input must be named. - filter_names <- names(filters) - if (any(vapply(filter_names, is_empty_char, FUN.VALUE = logical(1L)))) { - stop(wrap_txt("All elements in filters list must be named"), - call. = FALSE) - } - if (!is.null(use_centroids)) { - if (!all(use_centroids %in% filter_names)) { - stop("all entries in `use_centroids` must be names in `filters`\n", - call. = FALSE) - } - } - if (length(buffer) > 1L) { - buffer_names <- names(buffer) - if (is.null(buffer_names)) { - stop("if multiple `buffer` values given, they must be named\n", - call. = FALSE) - } - if (!all(buffer_names %in% filter_names)) { - stop("all names for `buffer` values must be names in `filters`\n", - call. = FALSE) - } + checkmate::assert_list(filters, types = "character") + if (!length(filters <= 2)) { + stop(wrap_txt("At least two elements in filters are needed.")) } - # main ---------------------------------------------------------- # - last_info <- tail(filter_names, 1L) # name of final filter layer - if (is.null(name)) name <- last_info + if (isTRUE(clip) & is.null(name)) { + stop(wrap_txt("If clip is true, a value to 'name' param should be + provided.")) + } - # check buffer behavior - for (f_i in seq_along(filters)) { - .check_filter_buffer_allowed( - i = f_i, - filters = filters, - buffer = buffer - ) + # check spat units input + spat_units <- names(filters) + if (any(vapply(spat_units, is_empty_char, FUN.VALUE = logical(1L)))) { + stop(wrap_txt("All elements in filters list must be named by the + spatial units being used.")) } + avail_polys <- list_spatial_info_names(gobject) + missing_polys <- spat_units[!spat_units %in% avail_polys] - # contains all logic for getting the ith filter SpatVector - .filter_get <- function(i) { - fname <- filter_names[[i]] - .squery_get_sv( - x = filters[[fname]], + last_info <- tail(spat_units, 1) # get final spatial info layer + if (is.null(name)) name <- last_info + # replace poly and meta if name not supplied + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = last_info, + feat_type = feat_type + ) + # cell_meta = getCellMetadata(gobject = gobject, + # spat_unit = last_info, + # feat_type = feat_type, + # output = 'cellMetaObj', + # copy_obj = TRUE) + # spatUnit(cell_meta) = name + # prov(cell_meta) = name + + # function to get subsetted spatvector + get_sv <- function(gobject, spat_unit, cell_id) { + # 'all' is passed, use all spatIDs found for that spat unit + if (identical(cell_id, "all")) { + IDs <- spatIDs(gobject, spat_unit = spat_unit) + } else { + IDs <- cell_id + } + sv <- getPolygonInfo( gobject = gobject, - spat_unit = fname, - centroids = fname %in% use_centroids, # logical - buffer = .squery_guess_buffer(buffer, fname) + polygon_name = spat_unit, + return_giottoPolygon = FALSE ) + sv[sv$poly_ID %in% IDs] } - # iterate intersections - # sv1 is the filter poly (or result of previous intersect iteration) + # get first poly + sv1 <- get_sv( + gobject = gobject, + spat_unit = spat_units[1L], + cell_id = filters[[spat_units[1L]]] + ) + + # iterate + # sv1 is the filter poly # sv2 is the data poly - sv1 <- .filter_get(1L) # get initial sv1 - if (make_valid) sv1 <- terra::makeValid(sv1) - for (f_i in 2:length(filters)) { - sv2 <- .filter_get(f_i) - vmsg(.v = verbose, sprintf("processing [%s] vs [%s]...", - filter_names[f_i - 1L], filter_names[f_i] - )) - if (make_valid) sv2 <- terra::makeValid(sv2) + for (unit in spat_units[2:length(spat_units)]) { + sv2 <- get_sv( + gobject = gobject, + spat_unit = unit, + cell_id = filters[[unit]] + ) sv1 <- terra::intersect(sv1, sv2) } - # update colnames of output geoms - is_pid_idx <- which(names(sv1) == "poly_ID") - names(sv1)[is_pid_idx] <- - c(filter_names[seq_len(length(filter_names) - 1L)], "poly_ID") - # reorder with "poly_ID" col first - sv1 <- sv1[, unique(c(tail(is_pid_idx, 1L), is_pid_idx))] - - if (return_table) { - return(data.table::as.data.table(sv1)) - } - - uids <- unique(sv1$poly_ID) - if (return_ids) return(uids) - - # if NOT clip, return the original polys that are selected. - if (!clip) { - sv1 <- .filter_get(length(filters)) - sv1 <- sv1[sv1$poly_ID %in% uids] - } - - # package as giottoPolygon + names(sv1) <- c("poly_ID", rev(spat_units)[2:length(spat_units)]) poly <- giottoPolygon( spatVector = sv1, name = name, - unique_ID_cache = uids + unique_ID_cache = unique(sv1$poly_ID) ) - if (combine_fragments && clip) { - poly[] <- terra::aggregate(poly[], - by = "poly_ID", - dissolve = dissolve - ) - } - - if (!return_gobject) return(poly) + # extract relationships which have been appended to sv1 for each intersect + # info for each new layer appended on the left, with at least the 'poly_ID' + # column being added each time. Expected layout: + # final_data_lyr, ..., filter_lyr4, filter_lyr3, filter_lyr2, filter_lyr1 + # + # final_data_lyr should remain named as poly_ID, but the others should be + # renamed as their respective spatial units - # set values - gobject <- setPolygonInfo(gobject = gobject, x = poly, initialize = FALSE) + # rels = terra::values(sv1) %>% + # data.table::setDT() + # + # hierarchy_info_idx = which(names(rels) == 'poly_ID') + # rels = rels[, ..hierarchy_info_idx] + # data.table::setnames(rels, new = c('cell_ID', + # rev(spat_units)[2:length(spat_units)])) - return(gobject) -} + # merge in relationship info + # cell_meta[] = merge(cell_meta[], rels) -# internals #### -# f name of filter -# fset set of all filter names in order -# buffer numeric. buffering value to use for centroids -.check_filter_buffer_allowed <- function( - i, filters, buffer) { - fname <- names(filters)[[i]] - is_sv_points <- if (inherits(filters[[i]], "SpatVector")) { - terra::is.points(filters[[i]]) - } else { - FALSE - } - is_point_class <- inherits( - filters[[i]], c("numeric", "integer", "spatLocsObj") - ) - - need_id <- FALSE - has_buffer <- .squery_guess_buffer(buffer, fname) > 0 - - # checks are only relevant for point classes. - # poly can be buffered or not whenever - if (!is_point_class) return(invisible()) - - if (i == length(filters)) { # if last filter - if (!has_buffer) { - # only IDs return is allowed - stop(wrap_txt( - "final layer of query is centroids and buffer to use is 0", - "Please use return_ids = TRUE"), call. = FALSE) - } - } else if (!has_buffer) { # not last but has no buffer - # not allowed. - stop(wrap_txtf( - "'%s' is not the last layer of query. - Assigned 'buffer' may not be 0", fname - ), call. = FALSE) - } -} - -#' @describeIn spatQuery deprecated alias. -#' @export -spatQueryGiottoPolygons <- spatQuery - - -# function to get subsetted spatvector -# `x` is the element from the filter list (may be an object or IDs to use) -# `centroids` is a logical for whether to use spatlocs/centroids instead of poly -# `buffer` is a logical. When centroids are used, the amount of buffer to apply - -.squery_get_sv <- function(x, ...) { - UseMethod(".squery_get_sv") -} - -.squery_get_sv.default <- function(x, ...) { - stop(wrap_txt("[spatQuery] unrecognized filter input type:", class(x)), - call. = FALSE) -} - -.squery_get_sv.character <- function(x, gobject, centroids, spat_unit, ...) { - x <- .squery_get_sv_handle_char( - x = x, - gobject = gobject, - centroids = centroids, - spat_unit = spat_unit - ) - .squery_get_sv(x, ...) -} - -.squery_get_sv.giottoPolygon <- function(x, centroids, ...) { - x <- x[] # coerce to sv poly - if (centroids) { - x <- centroids(x) - } - .squery_get_sv(x, ...) -} - -.squery_get_sv.numeric <- function(x, ...) { - x <- createSpatLocsObj(x, verbose = FALSE) - # setup default IDs - x[]$cell_ID <- sprintf("point_%d", nrow(x)) - .squery_get_sv(x, ...) -} - -.squery_get_sv.spatLocsObj <- function(x, ...) { - x <- .squery_sl_to_svpts(x) - .squery_get_sv(x, ...) -} - -.squery_get_sv.SpatVector <- function(x, buffer, ...) { - if (buffer > 0) { - x <- buffer(x, width = buffer) - } - x -} - - - -.squery_get_sv_handle_char <- function(gobject, centroids, spat_unit, x) { - avail_poly <- list_spatial_info_names(gobject) - sv <- NULL # initialize as NULL - if (centroids) { - avail_sl <- list_spatial_locations_names(gobject, - spat_unit = spat_unit - ) - if (spat_unit %in% avail_sl) { # centroid from spatlocs - sv <- getSpatialLocations(gobject, - spat_unit = spat_unit, - output = "spatLocsObj" - ) - sv <- .squery_sl_to_svpts(sv) - } else if (spat_unit %in% avail_poly) { # centroids from SpatVector - sv <- getPolygonInfo( - gobject = gobject, - polygon_name = spat_unit, - return_giottoPolygon = FALSE - ) - sv <- centroids(sv) - } - # if in neither, spatlocs or poly, sv remains as NULL. - } else if (spat_unit %in% avail_poly) { - sv <- getPolygonInfo( - gobject = gobject, - polygon_name = spat_unit, - return_giottoPolygon = FALSE - ) - } - - if (is.null(sv)) { - stop(sprintf("Requested filter '%s' not found in giotto object\n", x), - call. = FALSE) - } - - # filter by x if needed - if (identical(x, "all")) { - return(sv) # x = "all" is passed, use all - } else { - return(sv[sv$poly_ID %in% x]) # otherwise, filter by x ids - } -} + # set values + gobject <- setPolygonInfo(gobject = gobject, x = poly, initialize = FALSE) + # gobject = setCellMetadata(gobject = gobject, x = cell_meta) -# convert spatlocs to expected spatvector pts. -.squery_sl_to_svpts <- function(x) { - x <- as.points(x) - id_idx <- which(names(x) == "cell_ID") - names(x)[id_idx] <- "poly_ID" # rename IDs to match - x -} -.squery_guess_buffer <- function(b, spat_unit) { - if (length(b) == 1 && is.null(names(b))) return(b) - if (!spat_unit %in% names(b)) return(0) - b[[spat_unit]] + return(gobject) } diff --git a/README.Rmd b/README.Rmd index e3f7c3ba..e842fd7e 100644 --- a/README.Rmd +++ b/README.Rmd @@ -18,7 +18,7 @@ knitr::opts_chunk$set( ![Version](https://img.shields.io/github/r-package/v/drieslab/GiottoClass) [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) [![codecov](https://codecov.io/gh/drieslab/GiottoClass/branch/dev/graph/badge.svg)](https://app.codecov.io/gh/drieslab/GiottoClass?branch=dev) -[![R CMD check](https://img.shields.io/github/actions/workflow/status/drieslab/GiottoClass/staging_branch_workflow.yml?branch=staging&label=R%20CMD%20check)](https://github.com/drieslab/GiottoClass/actions/workflows/staging_branch_workflow.yml) +[![R-CMD-check](https://github.com/drieslab/GiottoClass/actions/workflows/main_check.yml/badge.svg)](https://github.com/drieslab/GiottoClass/actions/workflows/main_check.yml) [![GitHub issues](https://img.shields.io/github/issues/drieslab/Giotto)](https://github.com/drieslab/Giotto/issues) [![GitHub pulls](https://img.shields.io/github/issues-pr/drieslab/GiottoClass)](https://github.com/drieslab/GiottoClass/pulls) diff --git a/README.md b/README.md index 599485f3..8644077c 100644 --- a/README.md +++ b/README.md @@ -9,8 +9,7 @@ [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) [![codecov](https://codecov.io/gh/drieslab/GiottoClass/branch/dev/graph/badge.svg)](https://app.codecov.io/gh/drieslab/GiottoClass?branch=dev) -[![R CMD -check](https://img.shields.io/github/actions/workflow/status/drieslab/GiottoClass/staging_branch_workflow.yml?branch=staging&label=R%20CMD%20check)](https://github.com/drieslab/GiottoClass/actions/workflows/staging_branch_workflow.yml) +[![R-CMD-check](https://github.com/drieslab/GiottoClass/actions/workflows/main_check.yml/badge.svg)](https://github.com/drieslab/GiottoClass/actions/workflows/main_check.yml) [![GitHub issues](https://img.shields.io/github/issues/drieslab/Giotto)](https://github.com/drieslab/Giotto/issues) [![GitHub diff --git a/man/anndataToGiotto.Rd b/man/anndataToGiotto.Rd index a0fa2cf1..e9b11308 100644 --- a/man/anndataToGiotto.Rd +++ b/man/anndataToGiotto.Rd @@ -23,26 +23,21 @@ anndataToGiotto( \item{n_key_added}{equivalent of "key_added" argument from scanpy.pp. neighbors(). If multiple spatial networks are in the anndata object, a list of key_added terms may be provided. If converting an anndata object from -giottoToAnnData, the keys are saved in \code{.uns['NN_keys']} -and all keys are used in conversion unless specified in the function call. -Cannot be "spatial". This becomes the name of the nearest network in the gobject.} +giottoToAnnData, a .txt file may be provided, which was generated in that +function, i.e. \{spat_unit\}_\{feat_type\}_nn_network_keys_added.txt. Cannot +be "spatial". This becomes the name of the nearest network in the gobject.} \item{spatial_n_key_added}{equivalent of "key_added" argument from squidpy.gr.spatial_neighbors. If multiple spatial networks are in the anndata object, a list of key_added terms may be provided. If converting an -anndata object from giottoToAnnData, the keys are saved in \code{.uns['SN_keys']} -and all keys are used in conversion unless specified in the function call. +anndata object from giottoToAnnData, a .txt file may be provided, which was +generated in that function, +i.e. \{spat_unit\}_\{feat_type\}_spatial_network_keys_added.txt Cannot be the same as n_key_added.} \item{delaunay_spat_net}{binary parameter for spatial network. If TRUE, the spatial network is a delaunay network.} -\item{spat_enrich_key_added}{list of names of spatial enrichment annotations present in the anndata object. -If converting an anndata object from giottoToAnnData and the original Giotto object had -spatial enrichment annotations, the keys are saved in -\code{.uns['SE_keys']} -and all keys are used in conversion unless specified in the function call.} - \item{spat_unit}{desired spatial unit to use for conversion, default NULL} \item{feat_type}{desired feature type to use for conversion, default NULL} diff --git a/man/area.Rd b/man/area.Rd index f2c529fe..38ac744d 100644 --- a/man/area.Rd +++ b/man/area.Rd @@ -13,11 +13,7 @@ \arguments{ \item{x}{\code{giottoPolygon}} -\item{...}{ - Arguments passed on to \code{\link[terra:expanse]{terra::expanse}} - \describe{ - \item{\code{}}{} - }} +\item{...}{additional args to pass} } \value{ \code{numeric} vector of spatial area @@ -25,23 +21,17 @@ \description{ Compute the area covered by polygons } -\details{ -Giotto's methods do not hook into terra's \code{area()} generic. This is because -\code{area()} in terra is deprecated in favor of \code{expanse()}. Additionally, -Giotto suppresses warnings about unrecognized CRS, which are currently not -as relevant for biological data. -} \examples{ sl <- GiottoData::loadSubObjectMini("spatLocsObj") gpoly <- GiottoData::loadSubObjectMini("giottoPolygon") gpoints <- GiottoData::loadSubObjectMini("giottoPoints") # area of polygons -head(area(gpoly)) +area(gpoly) # area of the convex hull -area(hull(sl)) -feature_hulls <- hull(gpoints, by = "feat_ID") -head(area(feature_hulls)) +area(convHull(sl)) +feature_hulls <- convHull(gpoints, by = "feat_ID") +area(feature_hulls) } diff --git a/man/combineCellData.Rd b/man/combineCellData.Rd index d6d261db..e8efcd46 100644 --- a/man/combineCellData.Rd +++ b/man/combineCellData.Rd @@ -12,11 +12,7 @@ combineCellData( include_poly_info = TRUE, poly_info = "cell", include_spat_enr = TRUE, - spat_enr_names = NULL, - ext = NULL, - xlim = NULL, - ylim = NULL, - remove_background_polygon = TRUE + spat_enr_names = NULL ) } \arguments{ @@ -35,24 +31,12 @@ combineCellData( \item{include_spat_enr}{include information about spatial enrichment} \item{spat_enr_names}{names of spatial enrichment results to include} - -\item{ext}{numeric or SpatExtent (optional). A cropping extent to apply to -to the geometries.} - -\item{xlim, ylim}{numeric length of 2 (optional). x or y bounds to apply.} - -\item{remove_background_polygon}{logical (default = \code{TRUE}). \code{crop()} may -sometimes produce extent-filling polygons when the original geometry is -problematic or invalid. Set \code{TRUE} to remove these, based on whether a -polygon fills up most of the x and y range.} } \value{ data.table with combined spatial information } \description{ -Produce a table of information about the cells, including -the geometry and centroids information. This function will be simplified -in the future with \code{\link[=spatValues]{spatValues()}}. +combine cell data information } \examples{ g <- GiottoData::loadGiottoMini("vizgen") diff --git a/man/convHull.Rd b/man/convHull.Rd new file mode 100644 index 00000000..6fbdb4c9 --- /dev/null +++ b/man/convHull.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/methods-convHull.R +\name{convHull} +\alias{convHull} +\alias{minRect} +\alias{minCircle} +\alias{convHull,spatLocsObj-method} +\alias{convHull,giottoSpatial-method} +\alias{minRect,spatLocsObj-method} +\alias{minRect,giottoSpatial-method} +\alias{minCircle,spatLocsObj-method} +\alias{minCircle,giottoSpatial-method} +\title{Convex hull, minimal bounding rotated rectangle, and minimal bounding circle} +\usage{ +\S4method{convHull}{spatLocsObj}(x, by = "", ...) + +\S4method{convHull}{giottoSpatial}(x, by = "", ...) + +\S4method{minRect}{spatLocsObj}(x, by = "", ...) + +\S4method{minRect}{giottoSpatial}(x, by = "", ...) + +\S4method{minCircle}{spatLocsObj}(x, by = "", ...) + +\S4method{minCircle}{giottoSpatial}(x, by = "", ...) +} +\arguments{ +\item{x}{any of giotto image, giottoPolygon, giottoPoints, spatLocsObj, SpatVector} + +\item{by}{character (variable name), to get a new geometry for groups of input geometries} + +\item{\dots}{additional parameters to pass} +} +\value{ +SpatVector +} +\description{ +Get the convex hull, the minimal bounding rotated rectangle, +or minimal bounding circle of a Giotto spatial object or terra SpatVector +} +\examples{ +sl <- GiottoData::loadSubObjectMini("spatLocsObj") +gpoints <- GiottoData::loadSubObjectMini("giottoPoints") + +h <- convHull(sl) +plot(h) + +r <- minRect(sl) +plot(r) + +circ <- minCircle(gpoints, by = "feat_ID") +plot(circ, border = rainbow(100)) + +} diff --git a/man/createGiottoPolygon.Rd b/man/createGiottoPolygon.Rd index 4bc1f088..0fbfd0d4 100644 --- a/man/createGiottoPolygon.Rd +++ b/man/createGiottoPolygon.Rd @@ -11,14 +11,7 @@ \alias{createGiottoPolygonsFromGeoJSON} \title{Create giotto polygons object} \usage{ -\S4method{createGiottoPolygon}{character}( - x, - remove_background_polygon = TRUE, - background_algo = "range", - make_valid = FALSE, - verbose = TRUE, - ... -) +\S4method{createGiottoPolygon}{character}(x, ...) \S4method{createGiottoPolygon}{SpatVector}(x, name = "cell", calc_centroids = FALSE, verbose = TRUE) @@ -56,7 +49,7 @@ createGiottoPolygonsFromMask( maskfile, mask_method = c("guess", "single", "multiple"), name = "cell", - remove_background_polygon = TRUE, + remove_background_polygon = FALSE, background_algo = c("range"), fill_holes = TRUE, poly_IDs = NULL, @@ -86,8 +79,6 @@ createGiottoPolygonsFromGeoJSON( name = "cell", calc_centroids = FALSE, make_valid = FALSE, - remove_background_polygon = TRUE, - background_algo = "range", verbose = TRUE ) } @@ -95,17 +86,6 @@ createGiottoPolygonsFromGeoJSON( \item{x}{input. Filepath to a .GeoJSON or a mask image file. Can also be a data.frame with vertex 'x', 'y', and 'poly_ID' information.} -\item{remove_background_polygon}{try to remove background -polygon (default: TRUE)} - -\item{background_algo}{algorithm to remove background polygon} - -\item{make_valid}{logical. (default \code{FALSE}) Whether to run -\code{\link[terra:is.valid]{terra::makeValid()}} on the geometries. Setting this to \code{TRUE} may cause -read-in polygon attribute information to become out of sync.} - -\item{verbose}{be verbose} - \item{\dots}{additional params to pass. For character method, params pass to SpatRaster or SpatVector methods, depending on whether x was a filepath to a maskfile or a spatial file (ex: wkt, shp, GeoJSON) respectively.} @@ -116,9 +96,16 @@ be the name of the spatial unit that they define. See \link{giotto_schema}} \item{calc_centroids}{logical. (default \code{FALSE}) calculate centroids for polygons} +\item{verbose}{be verbose} + \item{mask_method}{how the mask file defines individual segmentation annotations. See \emph{mask_method} section} +\item{remove_background_polygon}{try to remove background +polygon (default: FALSE)} + +\item{background_algo}{algorithm to remove background polygon} + \item{fill_holes}{fill holes within created polygons} \item{poly_IDs}{character vector. Default = NULL. Custom unique names for @@ -146,6 +133,10 @@ dataframe} \item{copy_dt}{(default TRUE) if segmdfr is provided as dt, this determines whether a copy is made} +\item{make_valid}{logical. (default \code{FALSE}) Whether to run +\code{\link[terra:is.valid]{terra::makeValid()}} on the geometries. Setting this to \code{TRUE} may cause +read-in polygon attribute information to become out of sync.} + \item{maskfile}{path to mask file, a terra \code{SpatRaster}, or some other data class readable by \code{\link[terra:rast]{terra::rast()}}} diff --git a/man/hull.Rd b/man/hull.Rd deleted file mode 100644 index d74ded57..00000000 --- a/man/hull.Rd +++ /dev/null @@ -1,61 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/methods-hull.R -\name{hull} -\alias{hull} -\alias{minRect} -\alias{minCircle} -\alias{convHull} -\alias{hull,spatLocsObj-method} -\alias{hull,giottoSpatial-method} -\title{Convex, concave, rectangular and circular hulls} -\usage{ -\S4method{hull}{spatLocsObj}(x, by = "", param = 1, allowHoles = TRUE, tight = TRUE, ...) - -\S4method{hull}{giottoSpatial}(x, by = "", param = 1, allowHoles = TRUE, tight = TRUE, ...) - -minRect(x, ...) - -minCircle(x, ...) - -convHull(x, ...) -} -\arguments{ -\item{x}{any of giotto image, giottoPolygon, giottoPoints, spatLocsObj, SpatVector} - -\item{by}{character (variable name), to get a new geometry for groups of input geometries} - -\item{param}{numeric between 0 and 1. For the "concave_*" types only. For \code{type="concave_ratio"} this is The edge length ratio value, between 0 and 1. For \code{type="concave_length"} this the maximum edge length (a value > 0). For \code{type="concave_polygons"} thism specifies the maximum Edge Length as a fraction of the difference between the longest and shortest edge lengths between the polygons. This normalizes the maximum edge length to be scale-free. A value of 1 produces the convex hull; a value of 0 produces the original polygons} - -\item{allowHoles}{logical. May the output polygons contain holes? For "concave_*" methods only} - -\item{tight}{logical. Should the hull follow the outer boundaries of the input polygons? For "concave_length" with polygon geometry only} - -\item{...}{ - Arguments passed on to \code{\link[terra:convhull]{terra::hull}} - \describe{ - \item{\code{}}{} - }} -} -\value{ -SpatVector -} -\description{ -Compute a hull around Giotto spatial object or terra SpatVector. -The concaveness of the concave hull can be specified in different ways. -} -\examples{ -sl <- GiottoData::loadSubObjectMini("spatLocsObj") -gpoints <- GiottoData::loadSubObjectMini("giottoPoints") - -h <- hull(sl) -plot(h) - -r <- hull(sl, type = "rectangle") -plot(r) - -circ <- hull(gpoints, type = "circle", by = "feat_ID") -plot(circ, border = rainbow(100)) - -plot(hull(sl, type = "concave_ratio", param = 0.15, allowHoles = FALSE)) - -} diff --git a/man/processParam-class.Rd b/man/processParam-class.Rd index 9944dcfe..bd815077 100644 --- a/man/processParam-class.Rd +++ b/man/processParam-class.Rd @@ -3,7 +3,6 @@ \docType{class} \name{processParam-class} \alias{processParam-class} -\alias{processParam} \title{Parameter Classes for Data Processing Operations} \description{ Utility class that defines a data processing procedure and any params used diff --git a/man/spatQuery.Rd b/man/spatQuery.Rd deleted file mode 100644 index 02001ef8..00000000 --- a/man/spatQuery.Rd +++ /dev/null @@ -1,218 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/spatial_query.R -\name{spatQuery} -\alias{spatQuery} -\alias{spatQueryGiottoPolygons} -\title{Spatial Query} -\usage{ -spatQuery( - gobject, - filters, - name = "query_polys", - clip = TRUE, - use_centroids = NULL, - buffer = 0, - make_valid = FALSE, - combine_fragments = FALSE, - dissolve = FALSE, - return_table = FALSE, - return_ids = FALSE, - return_gobject = TRUE, - verbose = NULL -) - -spatQueryGiottoPolygons( - gobject, - filters, - name = "query_polys", - clip = TRUE, - use_centroids = NULL, - buffer = 0, - make_valid = FALSE, - combine_fragments = FALSE, - dissolve = FALSE, - return_table = FALSE, - return_ids = FALSE, - return_gobject = TRUE, - verbose = NULL -) -} -\arguments{ -\item{gobject}{\code{giotto} object} - -\item{filters}{named list of characters and/or \code{giottoPolygons} to use as -spatial filters for the final item in the list. -\itemize{ -\item [\code{character}] list name designates the gobject spatial unit to use as a -filter. The actual character values should either be \code{"all"} or a specific -vector of cell_IDs to use. -\item [\code{giottoPolygon}] inputs are directly used as filters. List names are -used when reporting the spatial relationships in output geometry objects. -These can also be used as centroids and additionally can be buffered. -\item [\code{SpatVector}] inputs are directly used. Can also be converted to -centroids and/or buffered. -\item [\code{numeric}] input is read as XY pairs (e.g. \code{c(x1, y1, x2, y2, ...)}), -to be used as centroids. These are bufferable. -\item ['spatLocsObj'] inputs are directly used as centroids. These are -bufferable. -}} - -\item{name}{(optional) character. If not \code{NULL}, a new spatial unit of this -name will be generated from the results.} - -\item{clip}{logical. Default = \code{TRUE}. Whether final round of querying should -produce polygons clipped by the polygons used to select them.} - -\item{use_centroids}{character vector. Values must correspond to names in -\code{filters}. Selected \code{filters} will be converted to centroids. (prefers -usage of the first set of spatlocs for that spat_unit)} - -\item{buffer}{numeric. Or named vector of numerics. Names must correspond to -those in \code{centroids}. Applies the specified buffer to the centroid to allow -it to be used in \code{filter}. A \code{0} will skip buffering, but this is only -permitted if is also the the last item in \code{filter}. Unbuffered points may -only return results as IDs (\code{return_ids = TRUE}). Do note that buffering on -a large number of elements can cause significant slowdowns.} - -\item{make_valid}{logical (default = \code{FALSE}). Whether to make geometries -valid before using them. Set \code{TRUE} if topology errors show up.} - -\item{combine_fragments}{logical. (default = \code{FALSE}). Whether to combine -geoms fragmented by the intersections as multipolygons based on the -\code{poly_ID} col. If \code{TRUE}, the operation may introduce \code{NA}s in the spatial -relationship information.} - -\item{dissolve}{logical. (default = \code{FALSE}). If \code{combine_fragments = TRUE}, -whether to also merge the multipolygon into a single polygon.} - -\item{return_table}{logical. (Default = \code{FALSE}) Overrides \code{return__object}. -If \code{TRUE}, return only the relationships as a \code{data.table}} - -\item{return_ids}{logical. (Default = \code{FALSE}) Overrides \code{return_gobject}. -If \code{TRUE}, return only the poly_IDs of the final entry in \code{filters}} - -\item{return_gobject}{logical. (Default = \verb{TRUE)}. Whether to return the new -set of polygons attached to the giotto object.} - -\item{verbose}{verbosity} -} -\value{ -\code{character} (IDs), \code{giottoPolygon}, or \code{giotto} depending on -\code{return_ids} and \code{return_gobject}. -} -\description{ -Select spatial geometries based on a list of spatial \code{filters}. -The final item in provided in the list is the layer of information -being queried.\cr -By default, results will be returned as a new polygon-based spatial unit -with selection information recorded in the associated cell metadata. \cr -Spatial queries may perform queries on the geometries themselves, so -\code{intersect()} operations are performed under the hood. For a lighter weight -option that just finds spatial relationships, see \code{\link[=relate]{relate()}} -} -\section{Functions}{ -\itemize{ -\item \code{spatQueryGiottoPolygons()}: deprecated alias. - -}} -\examples{ -g <- GiottoData::loadGiottoMini("vizgen") -pz0 <- getPolygonInfo(g, "z0") -boxgrid <- tessellate( - extent = ext(g), - shape = "square", - shape_size = 50, - name = "boxgrid" -) -hexarray <- tessellate( - extent = ext(g), - shape = "hexagon", - shape_size = 80, - name = "hexarray" -) -g <- setGiotto(g, boxgrid) -g <- setGiotto(g, hexarray) - -hex_ids <- sprintf("ID_\%d", c(1, 3, 6, 8, 17, 19, 23)) -box_ids <- sprintf("ID_\%d", c(12, 14, 15, 16, 22, 41, 44, 45, 51, 52, 62)) - -g <- spatQuery(g, - filters = list( - hexarray = hex_ids, - boxgrid = box_ids, - z0 = "all" - ), - return_gobject = TRUE -) -# extract polys since we attached it to the giotto object -qp <- g[[, "query_polys"]][[1]] - -qp2 <- spatQuery(g, - filters = list( - hexarray = hex_ids[3], - boxgrid = box_ids, - z0 = "all" - ), - buffer = c(hexarray = 150), - return_gobject = FALSE -) - -# check that extracted polys are being clipped as expected -plot(pz0) -plot(hexarray[hex_ids], border = "blue", add = TRUE) -plot(boxgrid[box_ids], add = TRUE, border = "red") -plot(qp, col = rainbow(20), add = TRUE) # selection by hex and box -plot(buffer(hexarray[hex_ids[3]], width = 150), add = TRUE) # buffered hex -plot(qp2, col = "black", add = TRUE) # selection by buffered hex and box - -# query for polys that fall within 100 units of a point -res <- spatQuery(g, - filters = list( - pts = c(6500, -4900), - z0 = "all" - ), - buffer = c(pts = 100), - return_gobject = FALSE, - make_valid = TRUE, - clip = FALSE -) - -pt_buffer <- buffer( - as.points(createSpatLocsObj(c(6500, -4900))), - 100 -) - -plot(pz0) -plot(pt_buffer, add = TRUE, border = "dodgerblue") # the selecting shape. -# note that clip = FALSE for this selection -plot(res, col = "red", add = TRUE) - -# only return the ids -ids <- spatQuery(g, - filters = list( - pts = c(6500, -4900), - z0 = "all" - ), - buffer = c(pts = 100), - return_ids = TRUE, - make_valid = TRUE -) -head(ids) -length(ids) - -# only return the table of relations -tab <- spatQuery(g, - filters = list( - hexarray = hex_ids, - boxgrid = box_ids, - z0 = "all" - ), - return_table = TRUE, - make_valid = TRUE -) -force(tab) - -} -\seealso{ -\code{\link[=relate]{relate()}} -} diff --git a/man/spatQueryGiottoPolygons.Rd b/man/spatQueryGiottoPolygons.Rd new file mode 100644 index 00000000..58f360ac --- /dev/null +++ b/man/spatQueryGiottoPolygons.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/spatial_query.R +\name{spatQueryGiottoPolygons} +\alias{spatQueryGiottoPolygons} +\title{Spatially query polygons within Giotto object} +\usage{ +spatQueryGiottoPolygons( + gobject, + filters, + name = "query_polys", + feat_type = NULL, + clip = TRUE +) +} +\arguments{ +\item{gobject}{Giotto object} + +\item{filters}{list of characters. Named list of IDs to query on as spatial +filters where the names designate the spatial unit to use and the character +values should either be 'all' or a vector of cell_IDs to use.} + +\item{name}{(optional) character. If not NULL, a new spatial unit of this +name will be generated from the results} + +\item{feat_type}{(optional) May be changed in future. Determines which +feature type metadata in which hierarchical selection information is stored.} + +\item{clip}{boolean. Default = FALSE. Whether final round of querying should +return polygons clipped by the polygons used to select them. If TRUE, a value +must be provided to \code{name} param to generate a new spatial unit} +} +\value{ +giottoPolygon +} +\description{ +Recursively select polygons based on a list of spatial filters. +Results will be returned as a new polygon-based spatial unit with selection +information recorded in the associated cell metadata. The final item in +provided in param \code{filters} is the layer of information being queried. +} +\seealso{ +\code{\link[=relate]{relate()}} +} diff --git a/man/spatialdataToGiotto.Rd b/man/spatialdataToGiotto.Rd index 6727304d..1bbeda9b 100644 --- a/man/spatialdataToGiotto.Rd +++ b/man/spatialdataToGiotto.Rd @@ -22,25 +22,22 @@ spatialdataToGiotto( \item{n_key_added}{equivalent of "key_added" argument from scanpy.pp.neighbors(). If multiple spatial networks are in the anndata object, a list of key_added terms may be provided. -If converting an anndata object from giottoToAnnData, the keys are saved in \code{.uns['NN_keys']} -and all keys are used in conversion unless specified in the function call. +If converting an anndata object from giottoToAnnData, a .txt file may be +provided, which was generated in that function, +i.e. \{spat_unit\}_\{feat_type\}_nn_network_keys_added.txt Cannot be "spatial". This becomes the name of the nearest network in the gobject.} \item{spatial_n_key_added}{equivalent of "key_added" argument from squidpy.gr.spatial_neighbors. If multiple spatial networks are in the anndata object, a list of key_added terms may be provided. -If converting a SpatialData object from giottoToSpatialData, the keys are saved in \code{.uns['SN_keys']} -and all keys are used in conversion unless specified in the function call. +If converting an anndata object from giottoToAnnData, a .txt file may be +provided, which was generated in that function, +i.e. \{spat_unit\}_\{feat_type\}_spatial_network_keys_added.txt Cannot be the same as n_key_added.} \item{delaunay_spat_net}{binary parameter for spatial network. If TRUE, the spatial network is a delaunay network.} -\item{spat_enrich_key_added}{list of names of spatial enrichment annotations added to the SpatialData object. -If converting an anndata object from giottoToAnnData and the original Giotto object had -spatial enrichment annotations, the keys are saved in \code{.uns['SE_keys']} -and all keys are used in conversion unless specified in the function call.} - \item{spat_unit}{desired spatial unit for conversion, default NULL} \item{feat_type}{desired feature type for conversion, default NULL} From beffc3d34f8996dbea3be1a04bb5869ee9915ab9 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Thu, 15 May 2025 12:39:46 -0400 Subject: [PATCH 25/45] Reapply "chore: catch up to staging" This reverts commit e18de8521983b358e8a8470bbb1535bda9bdb8a0. --- .github/workflows/staging_branch_workflow.yml | 22 +- DESCRIPTION | 4 +- NAMESPACE | 13 +- NEWS.md | 26 +- R/aggregate.R | 3 +- R/auxilliary.R | 25 +- R/classes.R | 9 + R/combine_metadata.R | 56 +- R/create.R | 91 ++- R/data_evaluation.R | 2 +- R/generics.R | 5 +- R/images.R | 5 +- R/interoperability.R | 78 +-- R/join.R | 1 + R/methods-area.R | 26 +- R/methods-convHull.R | 60 -- R/methods-hull.R | 77 +++ R/methods-initialize.R | 2 +- R/package_imports.R | 3 +- R/save_load.R | 37 +- R/slot_accessors.R | 2 +- R/spatial_query.R | 519 ++++++++++++++---- README.Rmd | 2 +- README.md | 3 +- man/anndataToGiotto.Rd | 17 +- man/area.Rd | 20 +- man/combineCellData.Rd | 20 +- man/convHull.Rd | 54 -- man/createGiottoPolygon.Rd | 35 +- man/hull.Rd | 61 ++ man/processParam-class.Rd | 1 + man/spatQuery.Rd | 218 ++++++++ man/spatQueryGiottoPolygons.Rd | 43 -- man/spatialdataToGiotto.Rd | 15 +- 34 files changed, 1121 insertions(+), 434 deletions(-) delete mode 100644 R/methods-convHull.R create mode 100644 R/methods-hull.R delete mode 100644 man/convHull.Rd create mode 100644 man/hull.Rd create mode 100644 man/spatQuery.Rd delete mode 100644 man/spatQueryGiottoPolygons.Rd diff --git a/.github/workflows/staging_branch_workflow.yml b/.github/workflows/staging_branch_workflow.yml index d45437c9..cc6b33f3 100644 --- a/.github/workflows/staging_branch_workflow.yml +++ b/.github/workflows/staging_branch_workflow.yml @@ -3,6 +3,9 @@ on: push: branches: [ staging ] + schedule: + - cron: '0 0 * * 1,4' # Run at midnight on Monday and Thursday + workflow_dispatch: # Allow manual trigger name: STAGING final checks @@ -40,7 +43,7 @@ jobs: if: runner.os == 'macOS' run: | brew install --cask xquartz - + - name: Install X11 on Ubuntu if: runner.os == 'Linux' run: | @@ -52,7 +55,7 @@ jobs: with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} - use-public-rspm: true + use-public-rspm: false - name: Set up dependencies (general) uses: r-lib/actions/setup-r-dependencies@v2 @@ -103,21 +106,28 @@ jobs: with: python-version: "3.10" + - name: report versions + shell: Rscript {0} + run: | + print(paste("terra:", packageVersion("terra"))) + print(paste("sf:", packageVersion("sf"))) + print(paste("SpatialExperiment:", packageVersion("SpatialExperiment"))) + - name: setup giotto_env shell: Rscript {0} run: | if (!GiottoClass::checkGiottoEnvironment()) { GiottoClass::installGiottoEnvironment() } - + reticulate::conda_install( envname = 'giotto_env', packages = 'scanpy', pip = TRUE ) - + path_to_python <- GiottoClass::set_giotto_python_path() - + writeLines(sprintf("RETICULATE_PYTHON=%s", path_to_python), Sys.getenv("GITHUB_ENV")) @@ -161,7 +171,7 @@ jobs: shell: Rscript {0} env: CODECOV_TOKEN: ${{ secrets.CODECOV_TOKEN }} - + bioccheck: needs: R-CMD-check runs-on: ubuntu-latest diff --git a/DESCRIPTION b/DESCRIPTION index 514832bf..b757a095 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,7 +26,7 @@ Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 Depends: - R (>= 4.4.0) + R (>= 4.4.1) Imports: checkmate, data.table (>= 1.12.2), @@ -110,13 +110,13 @@ Collate: 'methods-area.R' 'methods-centroids.R' 'methods-coerce.R' - 'methods-convHull.R' 'methods-copy.R' 'methods-crop.R' 'methods-dims.R' 'methods-ext.R' 'methods-extract.R' 'methods-flip.R' + 'methods-hull.R' 'methods-initialize.R' 'methods-instructions.R' 'methods-names.R' diff --git a/NAMESPACE b/NAMESPACE index 2676bd0d..834bc214 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -59,6 +59,7 @@ export(combineMetadata) export(combineSpatialCellMetadataInfo) export(combineToMultiPolygon) export(compatible_spatial_network) +export(convHull) export(convertGiottoLargeImageToMG) export(convert_mgImage_to_array_DT) export(convert_to_full_spatial_network) @@ -175,6 +176,8 @@ export(list_spatial_networks_names) export(loadGiotto) export(makePseudoVisium) export(mean_flex) +export(minCircle) +export(minRect) export(my_arowMeans) export(my_growMeans) export(my_rowMeans) @@ -252,6 +255,7 @@ export(showNetworks) export(showProcessingSteps) export(sliceGiotto) export(smoothGiottoPolygons) +export(spatQuery) export(spatQueryGiottoPolygons) export(spatValues) export(spat_net_to_igraph) @@ -330,7 +334,6 @@ exportMethods(calculateOverlap) exportMethods(centroids) exportMethods(colnames) exportMethods(combineGeom) -exportMethods(convHull) exportMethods(copy) exportMethods(createGiottoPoints) exportMethods(createGiottoPolygon) @@ -345,10 +348,9 @@ exportMethods(featIDs) exportMethods(featType) exportMethods(flip) exportMethods(hist) +exportMethods(hull) exportMethods(instructions) exportMethods(intersect) -exportMethods(minCircle) -exportMethods(minRect) exportMethods(ncol) exportMethods(nrow) exportMethods(objName) @@ -401,22 +403,19 @@ importFrom(methods,validObject) importFrom(utils,.DollarNames) importMethodsFrom(Matrix,t) importMethodsFrom(terra,"ext<-") -importMethodsFrom(terra,area) importMethodsFrom(terra,as.data.frame) importMethodsFrom(terra,as.points) importMethodsFrom(terra,as.polygons) importMethodsFrom(terra,buffer) importMethodsFrom(terra,centroids) -importMethodsFrom(terra,convHull) importMethodsFrom(terra,crop) importMethodsFrom(terra,density) importMethodsFrom(terra,erase) importMethodsFrom(terra,ext) importMethodsFrom(terra,flip) importMethodsFrom(terra,hist) +importMethodsFrom(terra,hull) importMethodsFrom(terra,intersect) -importMethodsFrom(terra,minCircle) -importMethodsFrom(terra,minRect) importMethodsFrom(terra,ncol) importMethodsFrom(terra,nrow) importMethodsFrom(terra,plot) diff --git a/NEWS.md b/NEWS.md index 21a042b7..c0a79d0b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,4 @@ + # GiottoClass 0.5.0 ## changes @@ -10,11 +11,15 @@ ## bug fixes - `overlaps()` will now properly find image overlaps -# GiottoClass 0.4.7 (2025/02/04) + + +# GiottoClass 0.4.7 (2025/05/06) ## new - `spatIDs()<-` for `giottoPolygon` - `combineGeom()` and `splitGeom()` for `giottoPolygon` +- `processData()` generic and `processParam` class +- `svkey` metaprogramming object for storing `spatValue()` parameters for later eval. ## bug fixes - fixes and updates for {spatialdata} and {anndata} interoperability. @@ -29,10 +34,21 @@ - fix `loadGiotto()` error when a non-expected reticulate environment is already activated in the session - fix `createGiottoLargeImage()` and `createGiottoPolygonsFromMask()` to align with {terra} `v1.8-21` `rast(noflip = TRUE)` [#1102](https://github.com/drieslab/Giotto/issues/1102) by StevenWijnen and rbutleriii - add fallback for when attributes do not match number of geometries in `createGiottoPolygon()` so that poly_ID col is not dropped +- fix `calculateOverlap()`when raster aggregation finds polygons with no values +- fix `createGiottoPolygon()` dispatch on `character` so that it can access poly cleanup params +- fix incorrect `giottoInstructions` class in older objects now possible via `updateGiottoObject()` +- Remove imports on deprecated {terra} `convHull()`, `minRect()`, `minCircle()`, in favor of `hull()` usage [#1153](https://github.com/drieslab/Giotto/issues/1153) by demographix +- Remove import on {terra} `area()`, define as new generic from {GiottoClass} +- fix `loadGiotto()` issue when there are multiple polygons and some only some of them have created centroids [#304](https://github.com/drieslab/GiottoClass/issues/304) +- fix `joinGiottoObjects` polygon joins when there is more than one set of polygons [#305](https://github.com/drieslab/GiottoClass/issues/305) ## changes +- `remove_background_poly` now defaults to `TRUE` during polygon ingestion - move {magick} from imports to suggests - {terra} `>=v1.8-21` +- deprecate `spatQueryGiottoPolygons()` in favor of more general `spatQuery()` +- deprecate `ometif_metadata()` in favor of `tif_metadata()` +- deprecate `ometif_to_tif()` in favor of `to_simple_tif()` ## enhancements - `[[` can now be used to select channels in `giottoLargeImage`-inheriting objects @@ -41,10 +57,12 @@ - `spatUnit()` and `featType()` method for `giotto` to find existing spatial units and feature types - expose `make_valid` param and `...` passing for `createGiottoPolygon()` `data.frame` method - `createGiottoPolygon()` `part_col` param for generating multipolygons from `data.frame-like` inputs. +- `combineCellData()` `ext`, `xlim`, `ylim` cropping. (also background poly removal in case of cropping artefacts) +- large improvements to anndata and spatialdata converters (see [#294](https://github.com/drieslab/GiottoClass/pull/294)) +- `spatLocsObj` can now be created from `numeric` xy pairs and xyz triplets +- improvements to `spatQuery()` +- add support for qptiff in `tif_metadata()` and `to_simple_tif()` -## new -- `processData()` generic and `processParam` class -- `svkey` metaprogramming object for storing `spatValue()` parameters for later eval. # GiottoClass 0.4.6 (2025/01/17) diff --git a/R/aggregate.R b/R/aggregate.R index 7eeec498..9a44744b 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -2082,7 +2082,8 @@ overlapToMatrixMultiPoly <- function(gobject, mat_c_names <- colnames(x) x[ match(mixedsort(mat_r_names), mat_r_names), - match(mixedsort(mat_c_names), mat_c_names) + match(mixedsort(mat_c_names), mat_c_names), + drop = FALSE ] } diff --git a/R/auxilliary.R b/R/auxilliary.R index 25123de9..56692b95 100644 --- a/R/auxilliary.R +++ b/R/auxilliary.R @@ -454,24 +454,7 @@ addCellMetadata <- function(gobject, ) - # 1. check hierarchical slots - # Expression information must first exist in the gobject for the - # corresponding metadata information to be added. - avail_ex <- list_expression( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - if (is.null(avail_ex)) { - .gstop( - "No matching expression information discovered for: - spat_unit:", spat_unit, "\nfeature type:", feat_type, - "\nPlease add expression information first" - ) - } - - - # 2. get the cell metadata to add to + # 1. get the cell metadata to add to cell_metadata <- getCellMetadata( gobject, spat_unit = spat_unit, @@ -484,7 +467,7 @@ addCellMetadata <- function(gobject, ordered_cell_IDs <- spatIDs(cell_metadata) - # 3. format input metadata + # 2. format input metadata # [vector/factor input] # Values are assumed to be in the same order as the existing metadata info. # Convert vector or factor into a single-column data.table @@ -523,7 +506,7 @@ addCellMetadata <- function(gobject, } - # 4. combine with existing metadata + # 3. combine with existing metadata # get old and new meta colnames that are not the ID col new_col_names <- colnames(new_metadata) new_col_names <- new_col_names[new_col_names != column_cell_ID] @@ -558,7 +541,7 @@ addCellMetadata <- function(gobject, } - # 5. ensure data is in same order as start and set data + # 4. ensure data is in same order as start and set data cell_metadata[] <- cell_metadata[][match(ordered_cell_IDs, cell_ID)] diff --git a/R/classes.R b/R/classes.R index b24cb85c..8d4fadfc 100644 --- a/R/classes.R +++ b/R/classes.R @@ -321,6 +321,7 @@ setClass( #' @title Parameter Classes for Data Processing Operations #' @name processParam-class +#' @aliases processParam #' @description #' Utility class that defines a data processing procedure and any params used #' in performing it. Packages defining processing methods will create their own @@ -436,6 +437,14 @@ updateGiottoObject <- function(gobject) { gobject@h5_file <- NULL } + # ensure instructions are of correct type + inst <- instructions(gobject) + if (!inherits(inst, c("giottoInstructions", "NULL")) && + inherits(inst, "list")) { + class(inst) <- c("giottoInstructions", "list") + instructions(gobject, initialize = FALSE) <- inst + } + # [Switch to GiottoClass versioning] --------------------------------------# # GiottoClass 0.1.2 adds max_window and colors slots to giottoLargeImage # this update function has been moved to .update_image_slot() below diff --git a/R/combine_metadata.R b/R/combine_metadata.R index 53e220bd..d089247e 100644 --- a/R/combine_metadata.R +++ b/R/combine_metadata.R @@ -167,7 +167,9 @@ combineSpatialCellMetadataInfo <- function(gobject, #' @title combineCellData #' @name combineCellData -#' @description combine cell data information +#' @description Produce a table of information about the cells, including +#' the geometry and centroids information. This function will be simplified +#' in the future with [spatValues()]. #' @param gobject giotto object #' @param feat_type feature type #' @param include_spat_locs include information about spatial locations @@ -176,6 +178,13 @@ combineSpatialCellMetadataInfo <- function(gobject, #' @param poly_info polygon information name #' @param include_spat_enr include information about spatial enrichment #' @param spat_enr_names names of spatial enrichment results to include +#' @param ext numeric or SpatExtent (optional). A cropping extent to apply to +#' to the geometries. +#' @param xlim,ylim numeric length of 2 (optional). x or y bounds to apply. +#' @param remove_background_polygon logical (default = `TRUE`). `crop()` may +#' sometimes produce extent-filling polygons when the original geometry is +#' problematic or invalid. Set `TRUE` to remove these, based on whether a +#' polygon fills up most of the x and y range. #' @concept combine cell metadata #' @returns data.table with combined spatial information #' @examples @@ -190,7 +199,15 @@ combineCellData <- function(gobject, include_poly_info = TRUE, poly_info = "cell", include_spat_enr = TRUE, - spat_enr_names = NULL) { + spat_enr_names = NULL, + ext = NULL, + xlim = NULL, + ylim = NULL, + remove_background_polygon = TRUE) { + + checkmate::assert_numeric(xlim, len = 2L, null.ok = TRUE) + checkmate::assert_numeric(ylim, len = 2L, null.ok = TRUE) + # combine # 1. spatial morphology information ( = polygon) # 2. cell metadata @@ -225,13 +242,39 @@ combineCellData <- function(gobject, ## spatial poly ## if (isTRUE(include_poly_info)) { # get spatial poly information - spatial_cell_info_spatvec <- getPolygonInfo( + sv <- getPolygonInfo( gobject = gobject, polygon_name = poly_info, return_giottoPolygon = FALSE ) + + e <- ext(sv) + need_crop <- FALSE + if (!is.null(xlim)) { + need_crop <- TRUE + e[c(1, 2)] <- xlim + } + if (!is.null(ylim)) { + need_crop <- TRUE + e[c(3, 4)] <- ylim + } + if (!is.null(ext)) { + need_crop <- TRUE + ext <- ext(ext) + e <- intersect(e, ext) + } + if (need_crop) { + sv <- crop(sv, e) + if (remove_background_polygon) { + sv <- .remove_background_polygon(sv, verbose = FALSE) + } + if (nrow(sv) == 0) { + warning("no geometries left after crop", call. = FALSE) + } + } + spatial_cell_info_dt <- data.table::as.data.table( - spatial_cell_info_spatvec, + sv, geom = "XY", include_values = TRUE ) @@ -243,7 +286,6 @@ combineCellData <- function(gobject, spatial_cell_info_dt <- NULL } - # combine spatloc and poly information if desired if (!is.null(spat_locs_dt) && !is.null(spatial_cell_info_dt)) { @@ -598,10 +640,6 @@ calculateSpatCellMetadataProportions <- function(gobject, ) data.table::setnames(x = proportions_mat, old = "source", new = "cell_ID") - # convert to matrix - # proportions_matrix = dt_to_matrix(proportions_mat) - # proportions_matrix[seq_len(4), seq_len(10)] - # create spatial enrichment object enrObj <- create_spat_enr_obj( name = name, diff --git a/R/create.R b/R/create.R index dcedfd24..2c324820 100644 --- a/R/create.R +++ b/R/create.R @@ -2406,7 +2406,12 @@ NULL #' @export setMethod( "createGiottoPolygon", signature("character"), - function(x, ...) { + function(x, + remove_background_polygon = TRUE, + background_algo = "range", + make_valid = FALSE, + verbose = TRUE, + ...) { checkmate::assert_file_exists(x) # try success means it should be mask file @@ -2425,11 +2430,30 @@ setMethod( # mask workflow if (inherits(try_rast, "SpatRaster")) { - return(createGiottoPolygon(try_rast, ...)) + return(createGiottoPolygon(try_rast, + remove_background_polygon = remove_background_polygon, + background_algo = background_algo, + verbose = verbose, + ... + )) } # file workflow - return(createGiottoPolygon(x = terra::vect(x), ...)) + reslist <- .evaluate_spatial_info(x, + make_valid = make_valid, + verbose = verbose + ) + + sv <- reslist$spatvector + + if (isTRUE(remove_background_polygon)) { + sv <- .remove_background_polygon(sv, + background_algo = background_algo, + verbose = verbose + ) + } + + createGiottoPolygon(sv, ...) } ) @@ -2538,7 +2562,7 @@ setMethod( #' @param mask_method how the mask file defines individual segmentation #' annotations. See *mask_method* section #' @param remove_background_polygon try to remove background -#' polygon (default: FALSE) +#' polygon (default: TRUE) #' @param background_algo algorithm to remove background polygon #' @param fill_holes fill holes within created polygons #' @param poly_IDs character vector. Default = NULL. Custom unique names for @@ -2581,7 +2605,7 @@ createGiottoPolygonsFromMask <- function( maskfile, mask_method = c("guess", "single", "multiple"), name = "cell", - remove_background_polygon = FALSE, + remove_background_polygon = TRUE, background_algo = c("range"), fill_holes = TRUE, poly_IDs = NULL, @@ -2736,26 +2760,10 @@ createGiottoPolygonsFromMask <- function( ## remove background polygon ## if (isTRUE(remove_background_polygon)) { - if (background_algo == "range") { - backgr_poly_id <- .identify_background_range_polygons( - terra_polygon - ) - if (length(backgr_poly_id) > 1L) { - warning("More than one background poly found.") - } - } - - if (length(backgr_poly_id) > 0) { - vmsg(.v = verbose, sprintf( - "removed background poly.\n ID was: %s", - backgr_poly_id - )) - - terra_polygon <- terra::subset( - x = terra_polygon, - terra_polygon[["poly_ID"]] != backgr_poly_id - ) - } + terra_polygon <- .remove_background_polygon(terra_polygon, + background_algo = background_algo, + verbose = verbose + ) } @@ -2877,6 +2885,8 @@ createGiottoPolygonsFromGeoJSON <- function(GeoJSON, name = "cell", calc_centroids = FALSE, make_valid = FALSE, + remove_background_polygon = TRUE, + background_algo = "range", verbose = TRUE) { eval_list <- .evaluate_spatial_info( spatial_info = GeoJSON, @@ -2887,6 +2897,14 @@ createGiottoPolygonsFromGeoJSON <- function(GeoJSON, spatvector <- eval_list$spatvector unique_IDs <- eval_list$unique_IDs + ## remove background polygon ## + if (isTRUE(remove_background_polygon)) { + spatvector <- .remove_background_polygon(spatvector, + background_algo = background_algo, + verbose = verbose + ) + } + g_polygon <- create_giotto_polygon_object( name = name, spatVector = spatvector, @@ -2910,7 +2928,30 @@ createGiottoPolygonsFromGeoJSON <- function(GeoJSON, +.remove_background_polygon <- function(x, + background_algo = "range", + verbose = NULL) { + ## remove background polygon ## + if (background_algo == "range") { + backgr_poly_id <- .identify_background_range_polygons(x) + if (length(backgr_poly_id) > 1L) { + warning("More than one background poly found.") + } + } + + if (length(backgr_poly_id) > 0) { + vmsg(.v = verbose, sprintf( + "removed background poly.\n ID was: %s", + backgr_poly_id + )) + x <- terra::subset( + x = x, + x[["poly_ID"]] != backgr_poly_id + ) + } + x +} #' @title Create a giotto polygon object diff --git a/R/data_evaluation.R b/R/data_evaluation.R index 69947ede..ba494782 100644 --- a/R/data_evaluation.R +++ b/R/data_evaluation.R @@ -112,7 +112,7 @@ evaluate_input <- function(type, x, ...) { } else if (target_class == "dbMatrix") { .gstop( "Automatic conversion to 'dbMatrix' is not supported within ", - "createExprObj(). Please provide a pre‑constructed ", + "createExprObj(). Please provide a pre-constructed ", "'dbMatrix' object instead. See ?dbMatrix for details." ) } else if (target_class == "DelayedArray") { diff --git a/R/generics.R b/R/generics.R index 949d141b..1ef50be3 100644 --- a/R/generics.R +++ b/R/generics.R @@ -111,9 +111,8 @@ setGeneric("XY<-", function(x, ..., value) standardGeneric("XY<-")) setGeneric("settleGeom", function(x, ...) standardGeneric("settleGeom")) setGeneric("combineGeom", function(x, ...) standardGeneric("combineGeom")) setGeneric("splitGeom", function(x, ...) standardGeneric("splitGeom")) -if (!isGeneric("area")) { - setGeneric("area", function(x, ...) standardGeneric("area")) -} +setGeneric("area", function(x, ...) standardGeneric("area")) + # Methods and documentations found in methods-overlaps.R setGeneric("overlaps", function(x, ...) standardGeneric("overlaps")) diff --git a/R/images.R b/R/images.R index d71ca77a..4934a3cb 100644 --- a/R/images.R +++ b/R/images.R @@ -709,12 +709,12 @@ reconnect_giottoImage_MG <- function( #' @keywords internal .spatraster_sample_values <- function(raster_object, size = 5000, - output = c("data.frame", "array", "magick", "EBImage"), + output = c("data.frame", "array", "magick", "EBImage", "SpatRaster"), verbose = NULL, ...) { output <- match.arg( arg = output, - choices = c("data.frame", "array", "magick", "EBImage") + choices = c("data.frame", "array", "magick", "EBImage", "SpatRaster") ) # account for possible giottoLargeImage input @@ -744,6 +744,7 @@ reconnect_giottoImage_MG <- function( if (isTRUE(argslist$as.df)) { res <- stats::na.omit(res) # data.frame remove NAs } else { + if (output == "SpatRaster") return(res) # all others res <- terra::as.array(res) na_bool <- is.na(res) diff --git a/R/interoperability.R b/R/interoperability.R index 1ec5c3f5..b7249647 100644 --- a/R/interoperability.R +++ b/R/interoperability.R @@ -203,18 +203,23 @@ check_py_for_scanpy <- function() { #' @param n_key_added equivalent of "key_added" argument from scanpy.pp. #' neighbors(). If multiple spatial networks are in the anndata object, a list #' of key_added terms may be provided. If converting an anndata object from -#' giottoToAnnData, a .txt file may be provided, which was generated in that -#' function, i.e. \{spat_unit\}_\{feat_type\}_nn_network_keys_added.txt. Cannot -#' be "spatial". This becomes the name of the nearest network in the gobject. +#' giottoToAnnData, the keys are saved in `.uns['NN_keys']` +#' and all keys are used in conversion unless specified in the function call. +#' Cannot be "spatial". This becomes the name of the nearest network in the gobject. #' @param spatial_n_key_added equivalent of "key_added" argument from #' squidpy.gr.spatial_neighbors. If multiple spatial networks are in the #' anndata object, a list of key_added terms may be provided. If converting an -#' anndata object from giottoToAnnData, a .txt file may be provided, which was -#' generated in that function, -#' i.e. \{spat_unit\}_\{feat_type\}_spatial_network_keys_added.txt +#' anndata object from giottoToAnnData, the keys are saved in `.uns['SN_keys']` +#' and all keys are used in conversion unless specified in the function call. #' Cannot be the same as n_key_added. #' @param delaunay_spat_net binary parameter for spatial network. If TRUE, the #' spatial network is a delaunay network. +#' @param spat_enrich_key_added +#' list of names of spatial enrichment annotations present in the anndata object. +#' If converting an anndata object from giottoToAnnData and the original Giotto object had +#' spatial enrichment annotations, the keys are saved in +#' `.uns['SE_keys']` +#' and all keys are used in conversion unless specified in the function call. #' @param spat_unit desired spatial unit to use for conversion, default NULL #' @param feat_type desired feature type to use for conversion, default NULL #' @param h5_file name to create and on-disk HDF5 file @@ -1152,7 +1157,7 @@ giottoToAnnData <- function(gobject = NULL, # Save SN keys to .uns['SN_keys'] if (length(network_name) != 0) { - save_SN_keys(adata = adata_list[[adata_pos]], + save_SN_keys(adata = adata_list[[adata_pos]], network_name = network_name) } } @@ -1164,9 +1169,9 @@ giottoToAnnData <- function(gobject = NULL, adata_pos <- 1 # Spatial Enrichment - spat_enrich_list <- list_giotto_data(gobject = gobject, + spat_enrich_list <- list_giotto_data(gobject = gobject, slot = "spatial_enrichment") - + if (!is.null(spat_enrich_list) && is.data.frame(spat_enrich_list)) { for (i in seq_len(nrow(spat_enrich_list))) { se_su <- spat_enrich_list[i]$spat_unit @@ -1186,7 +1191,7 @@ giottoToAnnData <- function(gobject = NULL, name = se_name ) } - save_SE_keys(adata = adata_list[[adata_pos]], + save_SE_keys(adata = adata_list[[adata_pos]], enrichment_name = spat_enrich_list$name) } @@ -3491,20 +3496,23 @@ giottoMasterToSuite <- function(gobject, #' @param n_key_added equivalent of "key_added" argument from scanpy.pp.neighbors(). #' If multiple spatial networks are in the anndata object, a list of key_added #' terms may be provided. -#' If converting an anndata object from giottoToAnnData, a .txt file may be -#' provided, which was generated in that function, -#' i.e. \{spat_unit\}_\{feat_type\}_nn_network_keys_added.txt +#' If converting an anndata object from giottoToAnnData, the keys are saved in `.uns['NN_keys']` +#' and all keys are used in conversion unless specified in the function call. #' Cannot be "spatial". This becomes the name of the nearest network in the gobject. #' @param spatial_n_key_added #' equivalent of "key_added" argument from squidpy.gr.spatial_neighbors. #' If multiple spatial networks are in the anndata object, a list of key_added #' terms may be provided. -#' If converting an anndata object from giottoToAnnData, a .txt file may be -#' provided, which was generated in that function, -#' i.e. \{spat_unit\}_\{feat_type\}_spatial_network_keys_added.txt +#' If converting a SpatialData object from giottoToSpatialData, the keys are saved in `.uns['SN_keys']` +#' and all keys are used in conversion unless specified in the function call. #' Cannot be the same as n_key_added. #' @param delaunay_spat_net binary parameter for spatial network. If TRUE, #' the spatial network is a delaunay network. +#' @param spat_enrich_key_added +#' list of names of spatial enrichment annotations added to the SpatialData object. +#' If converting an anndata object from giottoToAnnData and the original Giotto object had +#' spatial enrichment annotations, the keys are saved in `.uns['SE_keys']` +#' and all keys are used in conversion unless specified in the function call. #' @param spat_unit desired spatial unit for conversion, default NULL #' @param feat_type desired feature type for conversion, default NULL #' @param python_path path to python executable within a conda/miniconda environment @@ -3614,7 +3622,7 @@ spatialdataToGiotto <- function( } ft_list <- c(ft_list, ft) cat("Spatial unit and feature type extracted from table name.\n") - } + } else if (length(su_list_initial) > 0 && length(ft_list_initial) == 0) { su <- spat_unit ft <- "rna" @@ -3639,11 +3647,11 @@ spatialdataToGiotto <- function( ft_list <- c(ft_list, ft) cat("Default spatial unit and feature type have been set to [cell][rna]. If you wish to set a specific\nspatial unit and feature type, please specify it in the function call.\n") } - + gobject <- setExpression( - gobject, - x = createExprObj(expr_df_dict[[key]], name = "raw"), - spat_unit = su, + gobject, + x = createExprObj(expr_df_dict[[key]], name = "raw"), + spat_unit = su, feat_type = ft) } @@ -3727,13 +3735,13 @@ spatialdataToGiotto <- function( parts <- strsplit(key, "_")[[1]] spat_loc_su <- parts[1] gobject <- setSpatialLocations( - gobject, - x = createSpatLocsObj(spatial_dict[[key]], name = "raw"), + gobject, + x = createSpatLocsObj(spatial_dict[[key]], name = "raw"), spat_unit = spat_loc_su) } else { gobject <- setSpatialLocations( - gobject, - x = createSpatLocsObj(spatial_dict[[key]], name = "raw"), + gobject, + x = createSpatLocsObj(spatial_dict[[key]], name = "raw"), spat_unit = su) } } @@ -3802,7 +3810,7 @@ spatialdataToGiotto <- function( sk <- gsub("[()']", "", split_key[2]) s_distances_sd <- extract_SN_distances( - sdata, key_added = spatial_n_key_added_it, + sdata, key_added = spatial_n_key_added_it, tn = tn, sn_key_list = sk) ij_matrix <- methods::as(s_distances_sd, "TsparseMatrix") from_idx <- ij_matrix@i + 1 # zero index!!! @@ -3883,7 +3891,7 @@ spatialdataToGiotto <- function( ## Add PCA p_dict <- extract_pca(sdata) if (!is.null(p_dict)) { - for (tn in names(p_dict)) { + for (tn in names(p_dict)) { for (i in seq_along(p_dict[[tn]][[1]])) { p <- p_dict[[tn]][[1]][[i]] if (!is.null(p)) { @@ -3910,7 +3918,7 @@ spatialdataToGiotto <- function( my_rownames = rownames_vec ) gobject <- set_dimReduction( - gobject = gobject, + gobject = gobject, dimObject = dobj) } } @@ -3941,7 +3949,7 @@ spatialdataToGiotto <- function( my_rownames = rownames_vec ) gobject <- set_dimReduction( - gobject = gobject, + gobject = gobject, dimObject = dobj) } } @@ -4002,7 +4010,7 @@ spatialdataToGiotto <- function( nk <- gsub("[()']", "", split_key[2]) distances_sd <- extract_NN_distances( - sdata, key_added = n_key_added_it, + sdata, key_added = n_key_added_it, tn = tn, nn_key_list = nk) nn_dt <- align_network_data( @@ -4021,7 +4029,7 @@ spatialdataToGiotto <- function( nn_dt[, uniq_ID := NULL] vert <- unique(x = c(nn_dt$from_cell_ID, nn_dt$to_cell_ID)) nn_network_igraph <- igraph::graph_from_data_frame( - nn_dt[, .(from_cell_ID, to_cell_ID, weight, distance)], + nn_dt[, .(from_cell_ID, to_cell_ID, weight, distance)], directed = TRUE, vertices = vert) nn_info <- extract_NN_info( @@ -4097,13 +4105,13 @@ spatialdataToGiotto <- function( #' @param spat_unit spatial unit which will be used in conversion #' @param feat_type feature type which will be used in conversion #' @param spot_radius radius of the spots -#' @param python_path path to python executable within a conda/miniconda +#' @param python_path path to python executable within a conda/miniconda #' environment #' @param env_name name of environment containing python_path executable #' @param save_directory directory in which the SpatialData object will be saved #' #' @return SpatialData object saved on disk. -#' @details Function in beta. Converts and saves a Giotto object in SpatialData +#' @details Function in beta. Converts and saves a Giotto object in SpatialData #' format on disk. #' @export @@ -4188,7 +4196,7 @@ giottoToSpatialData <- function(gobject = NULL, for (su in spat_unit) { gpoly <- getPolygonInfo(gobject, polygon_name = su) gpoly_sf <- as.sf(gpoly) - sf::st_write(gpoly_sf, paste0(temp, "shapes/", su, ".geojson"), + sf::st_write(gpoly_sf, paste0(temp, "shapes/", su, ".geojson"), delete_dsn = TRUE) } } @@ -4199,7 +4207,7 @@ giottoToSpatialData <- function(gobject = NULL, for (ft in feat_type) { gpoint <- getFeatureInfo(gobject, feat_type = ft) gpoint_dt <- as.data.table(gpoint, geom = "XY") - fwrite(gpoint_dt, paste0(temp, "points/", ft, ".csv"), + fwrite(gpoint_dt, paste0(temp, "points/", ft, ".csv"), sep = ",", row.names = FALSE) } } diff --git a/R/join.R b/R/join.R index c8cc827e..afd35295 100644 --- a/R/join.R +++ b/R/join.R @@ -691,6 +691,7 @@ joinGiottoObjects <- function(gobject_list, for (gobj_i in seq_along(updated_object_list)) { gpoly <- getPolygonInfo( updated_object_list[[gobj_i]], + polygon_name = spat_info, return_giottoPolygon = TRUE ) spat_information_vector <- gpoly[] diff --git a/R/methods-area.R b/R/methods-area.R index 17a49905..04104821 100644 --- a/R/methods-area.R +++ b/R/methods-area.R @@ -1,9 +1,16 @@ # docs ----------------------------------------------------------- # #' @title Get the area of individual polygons #' @name area +#' @aliases area #' @description Compute the area covered by polygons +#' @details +#' Giotto's methods do not hook into terra's `area()` generic. This is because +#' `area()` in terra is deprecated in favor of `expanse()`. Additionally, +#' Giotto suppresses warnings about unrecognized CRS, which are currently not +#' as relevant for biological data. +#' #' @param x `giottoPolygon` -#' @param ... additional args to pass +#' @inheritDotParams terra::expanse #' @returns `numeric` vector of spatial area #' @examples #' sl <- GiottoData::loadSubObjectMini("spatLocsObj") @@ -11,12 +18,12 @@ #' gpoints <- GiottoData::loadSubObjectMini("giottoPoints") #' #' # area of polygons -#' area(gpoly) +#' head(area(gpoly)) #' #' # area of the convex hull -#' area(convHull(sl)) -#' feature_hulls <- convHull(gpoints, by = "feat_ID") -#' area(feature_hulls) +#' area(hull(sl)) +#' feature_hulls <- hull(gpoints, by = "feat_ID") +#' head(area(feature_hulls)) #' NULL # ---------------------------------------------------------------- # @@ -24,13 +31,16 @@ NULL #' @rdname area #' @export setMethod("area", signature("giottoPolygon"), function(x, ...) { - # handle warning about missing CRS - handle_warnings(area(x[], ...))$result + area(x[], ...) }) #' @rdname area #' @export setMethod("area", signature("SpatVector"), function(x, ...) { + area_params <- list(x, ...) + area_params$transform <- area_params$transform %null% FALSE # handle warning about missing CRS - handle_warnings(terra::expanse(x, transform = FALSE, ...))$result + handle_warnings({ + do.call(terra::expanse, args = area_params) + })$result }) diff --git a/R/methods-convHull.R b/R/methods-convHull.R deleted file mode 100644 index 30f20472..00000000 --- a/R/methods-convHull.R +++ /dev/null @@ -1,60 +0,0 @@ -# docs ----------------------------------------------------------- # -#' @title Convex hull, minimal bounding rotated rectangle, and minimal bounding circle -#' @name convHull -#' @aliases minRect minCircle -#' @description Get the convex hull, the minimal bounding rotated rectangle, -#' or minimal bounding circle of a Giotto spatial object or terra SpatVector -#' @param x any of giotto image, giottoPolygon, giottoPoints, spatLocsObj, SpatVector -#' @param by character (variable name), to get a new geometry for groups of input geometries -#' @param \dots additional parameters to pass -#' @examples -#' sl <- GiottoData::loadSubObjectMini("spatLocsObj") -#' gpoints <- GiottoData::loadSubObjectMini("giottoPoints") -#' -#' h <- convHull(sl) -#' plot(h) -#' -#' r <- minRect(sl) -#' plot(r) -#' -#' circ <- minCircle(gpoints, by = "feat_ID") -#' plot(circ, border = rainbow(100)) -#' -#' @returns SpatVector -NULL -# ---------------------------------------------------------------- # - -#' @rdname convHull -#' @export -setMethod("convHull", signature("spatLocsObj"), function(x, by = "", ...) { - convHull(x = as.points(x), by = by, ...) -}) -#' @rdname convHull -#' @export -setMethod("convHull", signature("giottoSpatial"), function(x, by = "", ...) { - convHull(x[], by = by, ...) -}) - - -#' @rdname convHull -#' @export -setMethod("minRect", signature("spatLocsObj"), function(x, by = "", ...) { - minRect(x = as.points(x), by = by, ...) -}) -#' @rdname convHull -#' @export -setMethod("minRect", signature("giottoSpatial"), function(x, by = "", ...) { - minRect(x[], by = by, ...) -}) - - -#' @rdname convHull -#' @export -setMethod("minCircle", signature("spatLocsObj"), function(x, by = "", ...) { - minCircle(x = as.points(x), by = by, ...) -}) -#' @rdname convHull -#' @export -setMethod("minCircle", signature("giottoSpatial"), function(x, by = "", ...) { - minCircle(x[], by = by, ...) -}) diff --git a/R/methods-hull.R b/R/methods-hull.R new file mode 100644 index 00000000..aa4d220d --- /dev/null +++ b/R/methods-hull.R @@ -0,0 +1,77 @@ +# docs ----------------------------------------------------------- # +#' @title Convex, concave, rectangular and circular hulls +#' @name hull +#' @aliases minRect minCircle convHull +#' @description Compute a hull around Giotto spatial object or terra SpatVector. +#' The concaveness of the concave hull can be specified in different ways. +#' @param x any of giotto image, giottoPolygon, giottoPoints, spatLocsObj, SpatVector +#' @param by character (variable name), to get a new geometry for groups of input geometries +#' @inheritParams terra::hull +#' @inheritDotParams terra::hull +#' @examples +#' sl <- GiottoData::loadSubObjectMini("spatLocsObj") +#' gpoints <- GiottoData::loadSubObjectMini("giottoPoints") +#' +#' h <- hull(sl) +#' plot(h) +#' +#' r <- hull(sl, type = "rectangle") +#' plot(r) +#' +#' circ <- hull(gpoints, type = "circle", by = "feat_ID") +#' plot(circ, border = rainbow(100)) +#' +#' plot(hull(sl, type = "concave_ratio", param = 0.15, allowHoles = FALSE)) +#' +#' @returns SpatVector +NULL +# ---------------------------------------------------------------- # + +#' @rdname hull +#' @export +setMethod("hull", signature("spatLocsObj"), function(x, by = "", param = 1, allowHoles = TRUE, tight = TRUE, ...) { + hull( + x = as.points(x), + by = by, + param = param, + allowHoles = allowHoles, + tight = tight, + ... + ) +}) +#' @rdname hull +#' @export +setMethod("hull", signature("giottoSpatial"), function(x, by = "", param = 1, allowHoles = TRUE, tight = TRUE, ...) { + hull( + x = x[], + by = by, + param = param, + allowHoles = allowHoles, + tight = tight, + ... + ) +}) + +#' @rdname hull +#' @export +minRect <- function(x, ...) { + warning("minRect() is deprecated. Please use hull() in the future.", + call. = FALSE) + hull(x, type = "rectangle", ...) +} + +#' @rdname hull +#' @export +minCircle <- function(x, ...) { + warning("minCircle() is deprecated. Please use hull() in the future.", + call. = FALSE) + hull(x, type = "circle", ...) +} + +#' @rdname hull +#' @export +convHull <- function(x, ...) { + warning("convHull() is deprecated. Please use hull() in the future.", + call. = FALSE) + hull(x, type = "convex", ...) +} diff --git a/R/methods-initialize.R b/R/methods-initialize.R index 9894f811..4b7386bb 100644 --- a/R/methods-initialize.R +++ b/R/methods-initialize.R @@ -387,7 +387,7 @@ setMethod("initialize", signature("giottoAffineImage"), function(.Object, ...) { # detect ID slots avail_cid <- list_cell_id_names(.Object) - avail_fid <- list_cell_id_names(.Object) + avail_fid <- list_feat_id_names(.Object) # detect metadata slots avail_cm <- list_cell_metadata(.Object) diff --git a/R/package_imports.R b/R/package_imports.R index 782d4133..367978ce 100644 --- a/R/package_imports.R +++ b/R/package_imports.R @@ -12,7 +12,7 @@ #' @importFrom graphics legend par rect #' @importMethodsFrom terra spin flip rescale t #' @importMethodsFrom Matrix t -#' @importMethodsFrom terra ext ext<- convHull minCircle minRect +#' @importMethodsFrom terra ext ext<- hull #' @importMethodsFrom terra plot #' @importMethodsFrom terra wrap #' @importMethodsFrom terra zoom @@ -23,7 +23,6 @@ #' @importMethodsFrom terra as.data.frame as.polygons as.points #' @importMethodsFrom terra nrow ncol #' @importMethodsFrom terra hist density -#' @importMethodsFrom terra area #' @importClassesFrom terra SpatExtent SpatVector #' @import GiottoUtils #' @import data.table diff --git a/R/save_load.R b/R/save_load.R index 862ab5d4..1c6ca423 100644 --- a/R/save_load.R +++ b/R/save_load.R @@ -568,7 +568,10 @@ loadGiotto <- function(path_to_folder, # these files are optional, depending on if they have been calculated. # They may not exist + # build expected filenames as file search terms shp_search <- paste0(spats, "_spatInfo_spatVectorCentroids.shp") + txt_search <- paste0(spats, "_spatInfo_spatVectorCentroids_names.txt") + # detect existing centroids files shp_files <- basenames[basenames %in% shp_search] # return early if none exist @@ -576,30 +579,36 @@ loadGiotto <- function(path_to_folder, return(gobject) } - txt_files <- paste0(spats, "_spatInfo_spatVectorCentroids_names.txt") + # apply name on search terms for simple and unique indexing + names(shp_search) <- names(txt_search) <- spats - # ordering of files follow spats - # apply name for simple and unique indexing - names(shp_files) <- names(txt_files) <- spats - - # iterate through spat_units and load/regen then append the data - # to the gobject + # iterate through spat_units for data load + # skip the spat_unit if file not found for (spat in spats) { - load_shp <- manifest[[shp_files[[spat]]]] - load_txt <- manifest[[txt_files[[spat]]]] + load_shp <- manifest[[shp_search[[spat]]]] + load_txt <- manifest[[txt_search[[spat]]]] if (is.null(load_shp)) next # skip to next spat_unit if none vmsg( .v = verbose, .is_debug = TRUE, .initial = " ", sprintf("[%s] %s", spat, basename(load_shp)) ) - spatVector <- terra::vect(load_shp) + missing_nametxt <- FALSE + if (is.null(load_txt)) { + warning(sprintf("[%s] missing centroid attribute names.txt", spat), + call. = FALSE) + missing_nametxt <- TRUE + } + # read in centroids + spatVector <- terra::vect(load_shp) # read in original column names and assign to spatVector - spatVector_names <- data.table::fread( - input = load_txt, header = FALSE - )[["V1"]] - names(spatVector) <- spatVector_names + if (!missing_nametxt) { + spatVector_names <- data.table::fread( + input = load_txt, header = FALSE + )[["V1"]] + names(spatVector) <- spatVector_names + } gobject@spatial_info[[spat]]@spatVectorCentroids <- spatVector } diff --git a/R/slot_accessors.R b/R/slot_accessors.R index 7e03a9be..a074a252 100644 --- a/R/slot_accessors.R +++ b/R/slot_accessors.R @@ -4995,7 +4995,7 @@ setFeatureInfo <- function(gobject, # NATIVE INPUT TYPES # 2. if input is giottoPoints or NULL, pass to internal - if (is.null(x) | inherits(x, "giottoPoints")) { + if (is.null(x) || inherits(x, "giottoPoints")) { # pass to internal gobject <- set_feature_info( gobject = gobject, diff --git a/R/spatial_query.R b/R/spatial_query.R index 93dee4a1..62e9f19f 100644 --- a/R/spatial_query.R +++ b/R/spatial_query.R @@ -1,136 +1,453 @@ ## * spatial queries #### + # If the polys are to be clipped, then the returned info MUST be a new polygon # object -#' @title Spatially query polygons within Giotto object -#' @name spatQueryGiottoPolygons -#' @description Recursively select polygons based on a list of spatial filters. -#' Results will be returned as a new polygon-based spatial unit with selection -#' information recorded in the associated cell metadata. The final item in -#' provided in param \code{filters} is the layer of information being queried. -#' @param gobject Giotto object -#' @param filters list of characters. Named list of IDs to query on as spatial -#' filters where the names designate the spatial unit to use and the character -#' values should either be 'all' or a vector of cell_IDs to use. -#' @param name (optional) character. If not NULL, a new spatial unit of this -#' name will be generated from the results -#' @param feat_type (optional) May be changed in future. Determines which -#' feature type metadata in which hierarchical selection information is stored. -#' @param clip boolean. Default = FALSE. Whether final round of querying should -#' return polygons clipped by the polygons used to select them. If TRUE, a value -#' must be provided to \code{name} param to generate a new spatial unit -#' @returns giottoPolygon +#' @title Spatial Query +#' @name spatQuery +#' @description Select spatial geometries based on a list of spatial `filters`. +#' The final item in provided in the list is the layer of information +#' being queried.\cr +#' By default, results will be returned as a new polygon-based spatial unit +#' with selection information recorded in the associated cell metadata. \cr +#' Spatial queries may perform queries on the geometries themselves, so +#' `intersect()` operations are performed under the hood. For a lighter weight +#' option that just finds spatial relationships, see [relate()] +#' @param gobject `giotto` object +#' @param filters named list of characters and/or `giottoPolygons` to use as +#' spatial filters for the final item in the list. +#' +#' * \[`character`\] list name designates the gobject spatial unit to use as a +#' filter. The actual character values should either be `"all"` or a specific +#' vector of cell_IDs to use. +#' * \[`giottoPolygon`\] inputs are directly used as filters. List names are +#' used when reporting the spatial relationships in output geometry objects. +#' These can also be used as centroids and additionally can be buffered. +#' * \[`SpatVector`] inputs are directly used. Can also be converted to +#' centroids and/or buffered. +#' * \[`numeric`\] input is read as XY pairs (e.g. `c(x1, y1, x2, y2, ...)`), +#' to be used as centroids. These are bufferable. +#' * \['spatLocsObj'\] inputs are directly used as centroids. These are +#' bufferable. +#' @param name (optional) character. If not `NULL`, a new spatial unit of this +#' name will be generated from the results. +#' @param clip logical. Default = `TRUE`. Whether final round of querying should +#' produce polygons clipped by the polygons used to select them. +#' @param use_centroids character vector. Values must correspond to names in +#' `filters`. Selected `filters` will be converted to centroids. (prefers +#' usage of the first set of spatlocs for that spat_unit) +#' @param buffer numeric. Or named vector of numerics. Names must correspond to +#' those in `centroids`. Applies the specified buffer to the centroid to allow +#' it to be used in `filter`. A `0` will skip buffering, but this is only +#' permitted if is also the the last item in `filter`. Unbuffered points may +#' only return results as IDs (`return_ids = TRUE`). Do note that buffering on +#' a large number of elements can cause significant slowdowns. +#' @param make_valid logical (default = `FALSE`). Whether to make geometries +#' valid before using them. Set `TRUE` if topology errors show up. +#' @param combine_fragments logical. (default = `FALSE`). Whether to combine +#' geoms fragmented by the intersections as multipolygons based on the +#' `poly_ID` col. If `TRUE`, the operation may introduce `NA`s in the spatial +#' relationship information. +#' @param dissolve logical. (default = `FALSE`). If `combine_fragments = TRUE`, +#' whether to also merge the multipolygon into a single polygon. +#' @param return_table logical. (Default = `FALSE`) Overrides `return__object`. +#' If `TRUE`, return only the relationships as a `data.table` +#' @param return_ids logical. (Default = `FALSE`) Overrides `return_gobject`. +#' If `TRUE`, return only the poly_IDs of the final entry in `filters` +#' @param return_gobject logical. (Default = `TRUE)`. Whether to return the new +#' set of polygons attached to the giotto object. +#' @param verbose verbosity +#' @returns `character` (IDs), `giottoPolygon`, or `giotto` depending on +#' `return_ids` and `return_gobject`. +#' @examples +#' g <- GiottoData::loadGiottoMini("vizgen") +#' pz0 <- getPolygonInfo(g, "z0") +#' boxgrid <- tessellate( +#' extent = ext(g), +#' shape = "square", +#' shape_size = 50, +#' name = "boxgrid" +#' ) +#' hexarray <- tessellate( +#' extent = ext(g), +#' shape = "hexagon", +#' shape_size = 80, +#' name = "hexarray" +#' ) +#' g <- setGiotto(g, boxgrid) +#' g <- setGiotto(g, hexarray) +#' +#' hex_ids <- sprintf("ID_%d", c(1, 3, 6, 8, 17, 19, 23)) +#' box_ids <- sprintf("ID_%d", c(12, 14, 15, 16, 22, 41, 44, 45, 51, 52, 62)) +#' +#' g <- spatQuery(g, +#' filters = list( +#' hexarray = hex_ids, +#' boxgrid = box_ids, +#' z0 = "all" +#' ), +#' return_gobject = TRUE +#' ) +#' # extract polys since we attached it to the giotto object +#' qp <- g[[, "query_polys"]][[1]] +#' +#' qp2 <- spatQuery(g, +#' filters = list( +#' hexarray = hex_ids[3], +#' boxgrid = box_ids, +#' z0 = "all" +#' ), +#' buffer = c(hexarray = 150), +#' return_gobject = FALSE +#' ) +#' +#' # check that extracted polys are being clipped as expected +#' plot(pz0) +#' plot(hexarray[hex_ids], border = "blue", add = TRUE) +#' plot(boxgrid[box_ids], add = TRUE, border = "red") +#' plot(qp, col = rainbow(20), add = TRUE) # selection by hex and box +#' plot(buffer(hexarray[hex_ids[3]], width = 150), add = TRUE) # buffered hex +#' plot(qp2, col = "black", add = TRUE) # selection by buffered hex and box +#' +#' # query for polys that fall within 100 units of a point +#' res <- spatQuery(g, +#' filters = list( +#' pts = c(6500, -4900), +#' z0 = "all" +#' ), +#' buffer = c(pts = 100), +#' return_gobject = FALSE, +#' make_valid = TRUE, +#' clip = FALSE +#' ) +#' +#' pt_buffer <- buffer( +#' as.points(createSpatLocsObj(c(6500, -4900))), +#' 100 +#' ) +#' +#' plot(pz0) +#' plot(pt_buffer, add = TRUE, border = "dodgerblue") # the selecting shape. +#' # note that clip = FALSE for this selection +#' plot(res, col = "red", add = TRUE) +#' +#' # only return the ids +#' ids <- spatQuery(g, +#' filters = list( +#' pts = c(6500, -4900), +#' z0 = "all" +#' ), +#' buffer = c(pts = 100), +#' return_ids = TRUE, +#' make_valid = TRUE +#' ) +#' head(ids) +#' length(ids) +#' +#' # only return the table of relations +#' tab <- spatQuery(g, +#' filters = list( +#' hexarray = hex_ids, +#' boxgrid = box_ids, +#' z0 = "all" +#' ), +#' return_table = TRUE, +#' make_valid = TRUE +#' ) +#' force(tab) +#' #' @seealso [relate()] #' @export -spatQueryGiottoPolygons <- function(gobject, +spatQuery <- function(gobject, filters, name = "query_polys", - feat_type = NULL, - clip = TRUE) { - assert_giotto(gobject) + clip = TRUE, + use_centroids = NULL, + buffer = 0, + make_valid = FALSE, + combine_fragments = FALSE, + dissolve = FALSE, + return_table = FALSE, + return_ids = FALSE, + return_gobject = TRUE, + verbose = NULL) { + # input type validation -------------------------------------------- # + if (!missing(gobject)) assert_giotto(gobject) if (!is.null(name)) checkmate::assert_character(name) - checkmate::assert_list(filters, types = "character") - if (!length(filters <= 2)) { - stop(wrap_txt("At least two elements in filters are needed.")) - } + checkmate::assert_list(filters, + types = c("character", "giottoPolygon", "spatLocsObj", "numeric", + "integer", "SpatVector") + ) + checkmate::assert_character(use_centroids, null.ok = TRUE) + checkmate::assert_numeric(buffer) + checkmate::assert_character(name) + checkmate::assert_logical(clip) + checkmate::assert_logical(return_ids) + checkmate::assert_logical(combine_fragments) + checkmate::assert_logical(return_gobject) - if (isTRUE(clip) & is.null(name)) { - stop(wrap_txt("If clip is true, a value to 'name' param should be - provided.")) + # more specific checks on inputs ----------------------------------- # + if (length(filters) < 2L) { + stop(wrap_txt("At least two elements in filters are needed."), + call. = FALSE) } - - # check spat units input - spat_units <- names(filters) - if (any(vapply(spat_units, is_empty_char, FUN.VALUE = logical(1L)))) { - stop(wrap_txt("All elements in filters list must be named by the - spatial units being used.")) + # `filters` input must be named. + filter_names <- names(filters) + if (any(vapply(filter_names, is_empty_char, FUN.VALUE = logical(1L)))) { + stop(wrap_txt("All elements in filters list must be named"), + call. = FALSE) + } + if (!is.null(use_centroids)) { + if (!all(use_centroids %in% filter_names)) { + stop("all entries in `use_centroids` must be names in `filters`\n", + call. = FALSE) + } + } + if (length(buffer) > 1L) { + buffer_names <- names(buffer) + if (is.null(buffer_names)) { + stop("if multiple `buffer` values given, they must be named\n", + call. = FALSE) + } + if (!all(buffer_names %in% filter_names)) { + stop("all names for `buffer` values must be names in `filters`\n", + call. = FALSE) + } } - avail_polys <- list_spatial_info_names(gobject) - missing_polys <- spat_units[!spat_units %in% avail_polys] - last_info <- tail(spat_units, 1) # get final spatial info layer + # main ---------------------------------------------------------- # + last_info <- tail(filter_names, 1L) # name of final filter layer if (is.null(name)) name <- last_info - # replace poly and meta if name not supplied - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = last_info, - feat_type = feat_type - ) - # cell_meta = getCellMetadata(gobject = gobject, - # spat_unit = last_info, - # feat_type = feat_type, - # output = 'cellMetaObj', - # copy_obj = TRUE) - # spatUnit(cell_meta) = name - # prov(cell_meta) = name - - # function to get subsetted spatvector - get_sv <- function(gobject, spat_unit, cell_id) { - # 'all' is passed, use all spatIDs found for that spat unit - if (identical(cell_id, "all")) { - IDs <- spatIDs(gobject, spat_unit = spat_unit) - } else { - IDs <- cell_id - } - sv <- getPolygonInfo( - gobject = gobject, - polygon_name = spat_unit, - return_giottoPolygon = FALSE + + # check buffer behavior + for (f_i in seq_along(filters)) { + .check_filter_buffer_allowed( + i = f_i, + filters = filters, + buffer = buffer ) - sv[sv$poly_ID %in% IDs] } - # get first poly - sv1 <- get_sv( - gobject = gobject, - spat_unit = spat_units[1L], - cell_id = filters[[spat_units[1L]]] - ) - - # iterate - # sv1 is the filter poly - # sv2 is the data poly - for (unit in spat_units[2:length(spat_units)]) { - sv2 <- get_sv( + # contains all logic for getting the ith filter SpatVector + .filter_get <- function(i) { + fname <- filter_names[[i]] + .squery_get_sv( + x = filters[[fname]], gobject = gobject, - spat_unit = unit, - cell_id = filters[[unit]] + spat_unit = fname, + centroids = fname %in% use_centroids, # logical + buffer = .squery_guess_buffer(buffer, fname) ) + } + + # iterate intersections + # sv1 is the filter poly (or result of previous intersect iteration) + # sv2 is the data poly + sv1 <- .filter_get(1L) # get initial sv1 + if (make_valid) sv1 <- terra::makeValid(sv1) + for (f_i in 2:length(filters)) { + sv2 <- .filter_get(f_i) + vmsg(.v = verbose, sprintf("processing [%s] vs [%s]...", + filter_names[f_i - 1L], filter_names[f_i] + )) + if (make_valid) sv2 <- terra::makeValid(sv2) sv1 <- terra::intersect(sv1, sv2) } - names(sv1) <- c("poly_ID", rev(spat_units)[2:length(spat_units)]) + # update colnames of output geoms + is_pid_idx <- which(names(sv1) == "poly_ID") + names(sv1)[is_pid_idx] <- + c(filter_names[seq_len(length(filter_names) - 1L)], "poly_ID") + # reorder with "poly_ID" col first + sv1 <- sv1[, unique(c(tail(is_pid_idx, 1L), is_pid_idx))] + + if (return_table) { + return(data.table::as.data.table(sv1)) + } + + uids <- unique(sv1$poly_ID) + if (return_ids) return(uids) + + # if NOT clip, return the original polys that are selected. + if (!clip) { + sv1 <- .filter_get(length(filters)) + sv1 <- sv1[sv1$poly_ID %in% uids] + } + + # package as giottoPolygon poly <- giottoPolygon( spatVector = sv1, name = name, - unique_ID_cache = unique(sv1$poly_ID) + unique_ID_cache = uids ) - # extract relationships which have been appended to sv1 for each intersect - # info for each new layer appended on the left, with at least the 'poly_ID' - # column being added each time. Expected layout: - # final_data_lyr, ..., filter_lyr4, filter_lyr3, filter_lyr2, filter_lyr1 - # - # final_data_lyr should remain named as poly_ID, but the others should be - # renamed as their respective spatial units - - # rels = terra::values(sv1) %>% - # data.table::setDT() - # - # hierarchy_info_idx = which(names(rels) == 'poly_ID') - # rels = rels[, ..hierarchy_info_idx] - # data.table::setnames(rels, new = c('cell_ID', - # rev(spat_units)[2:length(spat_units)])) - - # merge in relationship info - # cell_meta[] = merge(cell_meta[], rels) + if (combine_fragments && clip) { + poly[] <- terra::aggregate(poly[], + by = "poly_ID", + dissolve = dissolve + ) + } + if (!return_gobject) return(poly) # set values gobject <- setPolygonInfo(gobject = gobject, x = poly, initialize = FALSE) - # gobject = setCellMetadata(gobject = gobject, x = cell_meta) - return(gobject) } + +# internals #### + +# f name of filter +# fset set of all filter names in order +# buffer numeric. buffering value to use for centroids +.check_filter_buffer_allowed <- function( + i, filters, buffer) { + fname <- names(filters)[[i]] + is_sv_points <- if (inherits(filters[[i]], "SpatVector")) { + terra::is.points(filters[[i]]) + } else { + FALSE + } + is_point_class <- inherits( + filters[[i]], c("numeric", "integer", "spatLocsObj") + ) + + need_id <- FALSE + has_buffer <- .squery_guess_buffer(buffer, fname) > 0 + + # checks are only relevant for point classes. + # poly can be buffered or not whenever + if (!is_point_class) return(invisible()) + + if (i == length(filters)) { # if last filter + if (!has_buffer) { + # only IDs return is allowed + stop(wrap_txt( + "final layer of query is centroids and buffer to use is 0", + "Please use return_ids = TRUE"), call. = FALSE) + } + } else if (!has_buffer) { # not last but has no buffer + # not allowed. + stop(wrap_txtf( + "'%s' is not the last layer of query. + Assigned 'buffer' may not be 0", fname + ), call. = FALSE) + } +} + +#' @describeIn spatQuery deprecated alias. +#' @export +spatQueryGiottoPolygons <- spatQuery + + +# function to get subsetted spatvector +# `x` is the element from the filter list (may be an object or IDs to use) +# `centroids` is a logical for whether to use spatlocs/centroids instead of poly +# `buffer` is a logical. When centroids are used, the amount of buffer to apply + +.squery_get_sv <- function(x, ...) { + UseMethod(".squery_get_sv") +} + +.squery_get_sv.default <- function(x, ...) { + stop(wrap_txt("[spatQuery] unrecognized filter input type:", class(x)), + call. = FALSE) +} + +.squery_get_sv.character <- function(x, gobject, centroids, spat_unit, ...) { + x <- .squery_get_sv_handle_char( + x = x, + gobject = gobject, + centroids = centroids, + spat_unit = spat_unit + ) + .squery_get_sv(x, ...) +} + +.squery_get_sv.giottoPolygon <- function(x, centroids, ...) { + x <- x[] # coerce to sv poly + if (centroids) { + x <- centroids(x) + } + .squery_get_sv(x, ...) +} + +.squery_get_sv.numeric <- function(x, ...) { + x <- createSpatLocsObj(x, verbose = FALSE) + # setup default IDs + x[]$cell_ID <- sprintf("point_%d", nrow(x)) + .squery_get_sv(x, ...) +} + +.squery_get_sv.spatLocsObj <- function(x, ...) { + x <- .squery_sl_to_svpts(x) + .squery_get_sv(x, ...) +} + +.squery_get_sv.SpatVector <- function(x, buffer, ...) { + if (buffer > 0) { + x <- buffer(x, width = buffer) + } + x +} + + + +.squery_get_sv_handle_char <- function(gobject, centroids, spat_unit, x) { + avail_poly <- list_spatial_info_names(gobject) + sv <- NULL # initialize as NULL + if (centroids) { + avail_sl <- list_spatial_locations_names(gobject, + spat_unit = spat_unit + ) + if (spat_unit %in% avail_sl) { # centroid from spatlocs + sv <- getSpatialLocations(gobject, + spat_unit = spat_unit, + output = "spatLocsObj" + ) + sv <- .squery_sl_to_svpts(sv) + } else if (spat_unit %in% avail_poly) { # centroids from SpatVector + sv <- getPolygonInfo( + gobject = gobject, + polygon_name = spat_unit, + return_giottoPolygon = FALSE + ) + sv <- centroids(sv) + } + # if in neither, spatlocs or poly, sv remains as NULL. + } else if (spat_unit %in% avail_poly) { + sv <- getPolygonInfo( + gobject = gobject, + polygon_name = spat_unit, + return_giottoPolygon = FALSE + ) + } + + if (is.null(sv)) { + stop(sprintf("Requested filter '%s' not found in giotto object\n", x), + call. = FALSE) + } + + # filter by x if needed + if (identical(x, "all")) { + return(sv) # x = "all" is passed, use all + } else { + return(sv[sv$poly_ID %in% x]) # otherwise, filter by x ids + } +} + +# convert spatlocs to expected spatvector pts. +.squery_sl_to_svpts <- function(x) { + x <- as.points(x) + id_idx <- which(names(x) == "cell_ID") + names(x)[id_idx] <- "poly_ID" # rename IDs to match + x +} + +.squery_guess_buffer <- function(b, spat_unit) { + if (length(b) == 1 && is.null(names(b))) return(b) + if (!spat_unit %in% names(b)) return(0) + b[[spat_unit]] +} diff --git a/README.Rmd b/README.Rmd index e842fd7e..e3f7c3ba 100644 --- a/README.Rmd +++ b/README.Rmd @@ -18,7 +18,7 @@ knitr::opts_chunk$set( ![Version](https://img.shields.io/github/r-package/v/drieslab/GiottoClass) [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) [![codecov](https://codecov.io/gh/drieslab/GiottoClass/branch/dev/graph/badge.svg)](https://app.codecov.io/gh/drieslab/GiottoClass?branch=dev) -[![R-CMD-check](https://github.com/drieslab/GiottoClass/actions/workflows/main_check.yml/badge.svg)](https://github.com/drieslab/GiottoClass/actions/workflows/main_check.yml) +[![R CMD check](https://img.shields.io/github/actions/workflow/status/drieslab/GiottoClass/staging_branch_workflow.yml?branch=staging&label=R%20CMD%20check)](https://github.com/drieslab/GiottoClass/actions/workflows/staging_branch_workflow.yml) [![GitHub issues](https://img.shields.io/github/issues/drieslab/Giotto)](https://github.com/drieslab/Giotto/issues) [![GitHub pulls](https://img.shields.io/github/issues-pr/drieslab/GiottoClass)](https://github.com/drieslab/GiottoClass/pulls) diff --git a/README.md b/README.md index 8644077c..599485f3 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,8 @@ [![Lifecycle: stable](https://img.shields.io/badge/lifecycle-stable-brightgreen.svg)](https://lifecycle.r-lib.org/articles/stages.html#stable) [![codecov](https://codecov.io/gh/drieslab/GiottoClass/branch/dev/graph/badge.svg)](https://app.codecov.io/gh/drieslab/GiottoClass?branch=dev) -[![R-CMD-check](https://github.com/drieslab/GiottoClass/actions/workflows/main_check.yml/badge.svg)](https://github.com/drieslab/GiottoClass/actions/workflows/main_check.yml) +[![R CMD +check](https://img.shields.io/github/actions/workflow/status/drieslab/GiottoClass/staging_branch_workflow.yml?branch=staging&label=R%20CMD%20check)](https://github.com/drieslab/GiottoClass/actions/workflows/staging_branch_workflow.yml) [![GitHub issues](https://img.shields.io/github/issues/drieslab/Giotto)](https://github.com/drieslab/Giotto/issues) [![GitHub diff --git a/man/anndataToGiotto.Rd b/man/anndataToGiotto.Rd index e9b11308..a0fa2cf1 100644 --- a/man/anndataToGiotto.Rd +++ b/man/anndataToGiotto.Rd @@ -23,21 +23,26 @@ anndataToGiotto( \item{n_key_added}{equivalent of "key_added" argument from scanpy.pp. neighbors(). If multiple spatial networks are in the anndata object, a list of key_added terms may be provided. If converting an anndata object from -giottoToAnnData, a .txt file may be provided, which was generated in that -function, i.e. \{spat_unit\}_\{feat_type\}_nn_network_keys_added.txt. Cannot -be "spatial". This becomes the name of the nearest network in the gobject.} +giottoToAnnData, the keys are saved in \code{.uns['NN_keys']} +and all keys are used in conversion unless specified in the function call. +Cannot be "spatial". This becomes the name of the nearest network in the gobject.} \item{spatial_n_key_added}{equivalent of "key_added" argument from squidpy.gr.spatial_neighbors. If multiple spatial networks are in the anndata object, a list of key_added terms may be provided. If converting an -anndata object from giottoToAnnData, a .txt file may be provided, which was -generated in that function, -i.e. \{spat_unit\}_\{feat_type\}_spatial_network_keys_added.txt +anndata object from giottoToAnnData, the keys are saved in \code{.uns['SN_keys']} +and all keys are used in conversion unless specified in the function call. Cannot be the same as n_key_added.} \item{delaunay_spat_net}{binary parameter for spatial network. If TRUE, the spatial network is a delaunay network.} +\item{spat_enrich_key_added}{list of names of spatial enrichment annotations present in the anndata object. +If converting an anndata object from giottoToAnnData and the original Giotto object had +spatial enrichment annotations, the keys are saved in +\code{.uns['SE_keys']} +and all keys are used in conversion unless specified in the function call.} + \item{spat_unit}{desired spatial unit to use for conversion, default NULL} \item{feat_type}{desired feature type to use for conversion, default NULL} diff --git a/man/area.Rd b/man/area.Rd index 38ac744d..f2c529fe 100644 --- a/man/area.Rd +++ b/man/area.Rd @@ -13,7 +13,11 @@ \arguments{ \item{x}{\code{giottoPolygon}} -\item{...}{additional args to pass} +\item{...}{ + Arguments passed on to \code{\link[terra:expanse]{terra::expanse}} + \describe{ + \item{\code{}}{} + }} } \value{ \code{numeric} vector of spatial area @@ -21,17 +25,23 @@ \description{ Compute the area covered by polygons } +\details{ +Giotto's methods do not hook into terra's \code{area()} generic. This is because +\code{area()} in terra is deprecated in favor of \code{expanse()}. Additionally, +Giotto suppresses warnings about unrecognized CRS, which are currently not +as relevant for biological data. +} \examples{ sl <- GiottoData::loadSubObjectMini("spatLocsObj") gpoly <- GiottoData::loadSubObjectMini("giottoPolygon") gpoints <- GiottoData::loadSubObjectMini("giottoPoints") # area of polygons -area(gpoly) +head(area(gpoly)) # area of the convex hull -area(convHull(sl)) -feature_hulls <- convHull(gpoints, by = "feat_ID") -area(feature_hulls) +area(hull(sl)) +feature_hulls <- hull(gpoints, by = "feat_ID") +head(area(feature_hulls)) } diff --git a/man/combineCellData.Rd b/man/combineCellData.Rd index e8efcd46..d6d261db 100644 --- a/man/combineCellData.Rd +++ b/man/combineCellData.Rd @@ -12,7 +12,11 @@ combineCellData( include_poly_info = TRUE, poly_info = "cell", include_spat_enr = TRUE, - spat_enr_names = NULL + spat_enr_names = NULL, + ext = NULL, + xlim = NULL, + ylim = NULL, + remove_background_polygon = TRUE ) } \arguments{ @@ -31,12 +35,24 @@ combineCellData( \item{include_spat_enr}{include information about spatial enrichment} \item{spat_enr_names}{names of spatial enrichment results to include} + +\item{ext}{numeric or SpatExtent (optional). A cropping extent to apply to +to the geometries.} + +\item{xlim, ylim}{numeric length of 2 (optional). x or y bounds to apply.} + +\item{remove_background_polygon}{logical (default = \code{TRUE}). \code{crop()} may +sometimes produce extent-filling polygons when the original geometry is +problematic or invalid. Set \code{TRUE} to remove these, based on whether a +polygon fills up most of the x and y range.} } \value{ data.table with combined spatial information } \description{ -combine cell data information +Produce a table of information about the cells, including +the geometry and centroids information. This function will be simplified +in the future with \code{\link[=spatValues]{spatValues()}}. } \examples{ g <- GiottoData::loadGiottoMini("vizgen") diff --git a/man/convHull.Rd b/man/convHull.Rd deleted file mode 100644 index 6fbdb4c9..00000000 --- a/man/convHull.Rd +++ /dev/null @@ -1,54 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/methods-convHull.R -\name{convHull} -\alias{convHull} -\alias{minRect} -\alias{minCircle} -\alias{convHull,spatLocsObj-method} -\alias{convHull,giottoSpatial-method} -\alias{minRect,spatLocsObj-method} -\alias{minRect,giottoSpatial-method} -\alias{minCircle,spatLocsObj-method} -\alias{minCircle,giottoSpatial-method} -\title{Convex hull, minimal bounding rotated rectangle, and minimal bounding circle} -\usage{ -\S4method{convHull}{spatLocsObj}(x, by = "", ...) - -\S4method{convHull}{giottoSpatial}(x, by = "", ...) - -\S4method{minRect}{spatLocsObj}(x, by = "", ...) - -\S4method{minRect}{giottoSpatial}(x, by = "", ...) - -\S4method{minCircle}{spatLocsObj}(x, by = "", ...) - -\S4method{minCircle}{giottoSpatial}(x, by = "", ...) -} -\arguments{ -\item{x}{any of giotto image, giottoPolygon, giottoPoints, spatLocsObj, SpatVector} - -\item{by}{character (variable name), to get a new geometry for groups of input geometries} - -\item{\dots}{additional parameters to pass} -} -\value{ -SpatVector -} -\description{ -Get the convex hull, the minimal bounding rotated rectangle, -or minimal bounding circle of a Giotto spatial object or terra SpatVector -} -\examples{ -sl <- GiottoData::loadSubObjectMini("spatLocsObj") -gpoints <- GiottoData::loadSubObjectMini("giottoPoints") - -h <- convHull(sl) -plot(h) - -r <- minRect(sl) -plot(r) - -circ <- minCircle(gpoints, by = "feat_ID") -plot(circ, border = rainbow(100)) - -} diff --git a/man/createGiottoPolygon.Rd b/man/createGiottoPolygon.Rd index 0fbfd0d4..4bc1f088 100644 --- a/man/createGiottoPolygon.Rd +++ b/man/createGiottoPolygon.Rd @@ -11,7 +11,14 @@ \alias{createGiottoPolygonsFromGeoJSON} \title{Create giotto polygons object} \usage{ -\S4method{createGiottoPolygon}{character}(x, ...) +\S4method{createGiottoPolygon}{character}( + x, + remove_background_polygon = TRUE, + background_algo = "range", + make_valid = FALSE, + verbose = TRUE, + ... +) \S4method{createGiottoPolygon}{SpatVector}(x, name = "cell", calc_centroids = FALSE, verbose = TRUE) @@ -49,7 +56,7 @@ createGiottoPolygonsFromMask( maskfile, mask_method = c("guess", "single", "multiple"), name = "cell", - remove_background_polygon = FALSE, + remove_background_polygon = TRUE, background_algo = c("range"), fill_holes = TRUE, poly_IDs = NULL, @@ -79,6 +86,8 @@ createGiottoPolygonsFromGeoJSON( name = "cell", calc_centroids = FALSE, make_valid = FALSE, + remove_background_polygon = TRUE, + background_algo = "range", verbose = TRUE ) } @@ -86,6 +95,17 @@ createGiottoPolygonsFromGeoJSON( \item{x}{input. Filepath to a .GeoJSON or a mask image file. Can also be a data.frame with vertex 'x', 'y', and 'poly_ID' information.} +\item{remove_background_polygon}{try to remove background +polygon (default: TRUE)} + +\item{background_algo}{algorithm to remove background polygon} + +\item{make_valid}{logical. (default \code{FALSE}) Whether to run +\code{\link[terra:is.valid]{terra::makeValid()}} on the geometries. Setting this to \code{TRUE} may cause +read-in polygon attribute information to become out of sync.} + +\item{verbose}{be verbose} + \item{\dots}{additional params to pass. For character method, params pass to SpatRaster or SpatVector methods, depending on whether x was a filepath to a maskfile or a spatial file (ex: wkt, shp, GeoJSON) respectively.} @@ -96,16 +116,9 @@ be the name of the spatial unit that they define. See \link{giotto_schema}} \item{calc_centroids}{logical. (default \code{FALSE}) calculate centroids for polygons} -\item{verbose}{be verbose} - \item{mask_method}{how the mask file defines individual segmentation annotations. See \emph{mask_method} section} -\item{remove_background_polygon}{try to remove background -polygon (default: FALSE)} - -\item{background_algo}{algorithm to remove background polygon} - \item{fill_holes}{fill holes within created polygons} \item{poly_IDs}{character vector. Default = NULL. Custom unique names for @@ -133,10 +146,6 @@ dataframe} \item{copy_dt}{(default TRUE) if segmdfr is provided as dt, this determines whether a copy is made} -\item{make_valid}{logical. (default \code{FALSE}) Whether to run -\code{\link[terra:is.valid]{terra::makeValid()}} on the geometries. Setting this to \code{TRUE} may cause -read-in polygon attribute information to become out of sync.} - \item{maskfile}{path to mask file, a terra \code{SpatRaster}, or some other data class readable by \code{\link[terra:rast]{terra::rast()}}} diff --git a/man/hull.Rd b/man/hull.Rd new file mode 100644 index 00000000..d74ded57 --- /dev/null +++ b/man/hull.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/methods-hull.R +\name{hull} +\alias{hull} +\alias{minRect} +\alias{minCircle} +\alias{convHull} +\alias{hull,spatLocsObj-method} +\alias{hull,giottoSpatial-method} +\title{Convex, concave, rectangular and circular hulls} +\usage{ +\S4method{hull}{spatLocsObj}(x, by = "", param = 1, allowHoles = TRUE, tight = TRUE, ...) + +\S4method{hull}{giottoSpatial}(x, by = "", param = 1, allowHoles = TRUE, tight = TRUE, ...) + +minRect(x, ...) + +minCircle(x, ...) + +convHull(x, ...) +} +\arguments{ +\item{x}{any of giotto image, giottoPolygon, giottoPoints, spatLocsObj, SpatVector} + +\item{by}{character (variable name), to get a new geometry for groups of input geometries} + +\item{param}{numeric between 0 and 1. For the "concave_*" types only. For \code{type="concave_ratio"} this is The edge length ratio value, between 0 and 1. For \code{type="concave_length"} this the maximum edge length (a value > 0). For \code{type="concave_polygons"} thism specifies the maximum Edge Length as a fraction of the difference between the longest and shortest edge lengths between the polygons. This normalizes the maximum edge length to be scale-free. A value of 1 produces the convex hull; a value of 0 produces the original polygons} + +\item{allowHoles}{logical. May the output polygons contain holes? For "concave_*" methods only} + +\item{tight}{logical. Should the hull follow the outer boundaries of the input polygons? For "concave_length" with polygon geometry only} + +\item{...}{ + Arguments passed on to \code{\link[terra:convhull]{terra::hull}} + \describe{ + \item{\code{}}{} + }} +} +\value{ +SpatVector +} +\description{ +Compute a hull around Giotto spatial object or terra SpatVector. +The concaveness of the concave hull can be specified in different ways. +} +\examples{ +sl <- GiottoData::loadSubObjectMini("spatLocsObj") +gpoints <- GiottoData::loadSubObjectMini("giottoPoints") + +h <- hull(sl) +plot(h) + +r <- hull(sl, type = "rectangle") +plot(r) + +circ <- hull(gpoints, type = "circle", by = "feat_ID") +plot(circ, border = rainbow(100)) + +plot(hull(sl, type = "concave_ratio", param = 0.15, allowHoles = FALSE)) + +} diff --git a/man/processParam-class.Rd b/man/processParam-class.Rd index bd815077..9944dcfe 100644 --- a/man/processParam-class.Rd +++ b/man/processParam-class.Rd @@ -3,6 +3,7 @@ \docType{class} \name{processParam-class} \alias{processParam-class} +\alias{processParam} \title{Parameter Classes for Data Processing Operations} \description{ Utility class that defines a data processing procedure and any params used diff --git a/man/spatQuery.Rd b/man/spatQuery.Rd new file mode 100644 index 00000000..02001ef8 --- /dev/null +++ b/man/spatQuery.Rd @@ -0,0 +1,218 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/spatial_query.R +\name{spatQuery} +\alias{spatQuery} +\alias{spatQueryGiottoPolygons} +\title{Spatial Query} +\usage{ +spatQuery( + gobject, + filters, + name = "query_polys", + clip = TRUE, + use_centroids = NULL, + buffer = 0, + make_valid = FALSE, + combine_fragments = FALSE, + dissolve = FALSE, + return_table = FALSE, + return_ids = FALSE, + return_gobject = TRUE, + verbose = NULL +) + +spatQueryGiottoPolygons( + gobject, + filters, + name = "query_polys", + clip = TRUE, + use_centroids = NULL, + buffer = 0, + make_valid = FALSE, + combine_fragments = FALSE, + dissolve = FALSE, + return_table = FALSE, + return_ids = FALSE, + return_gobject = TRUE, + verbose = NULL +) +} +\arguments{ +\item{gobject}{\code{giotto} object} + +\item{filters}{named list of characters and/or \code{giottoPolygons} to use as +spatial filters for the final item in the list. +\itemize{ +\item [\code{character}] list name designates the gobject spatial unit to use as a +filter. The actual character values should either be \code{"all"} or a specific +vector of cell_IDs to use. +\item [\code{giottoPolygon}] inputs are directly used as filters. List names are +used when reporting the spatial relationships in output geometry objects. +These can also be used as centroids and additionally can be buffered. +\item [\code{SpatVector}] inputs are directly used. Can also be converted to +centroids and/or buffered. +\item [\code{numeric}] input is read as XY pairs (e.g. \code{c(x1, y1, x2, y2, ...)}), +to be used as centroids. These are bufferable. +\item ['spatLocsObj'] inputs are directly used as centroids. These are +bufferable. +}} + +\item{name}{(optional) character. If not \code{NULL}, a new spatial unit of this +name will be generated from the results.} + +\item{clip}{logical. Default = \code{TRUE}. Whether final round of querying should +produce polygons clipped by the polygons used to select them.} + +\item{use_centroids}{character vector. Values must correspond to names in +\code{filters}. Selected \code{filters} will be converted to centroids. (prefers +usage of the first set of spatlocs for that spat_unit)} + +\item{buffer}{numeric. Or named vector of numerics. Names must correspond to +those in \code{centroids}. Applies the specified buffer to the centroid to allow +it to be used in \code{filter}. A \code{0} will skip buffering, but this is only +permitted if is also the the last item in \code{filter}. Unbuffered points may +only return results as IDs (\code{return_ids = TRUE}). Do note that buffering on +a large number of elements can cause significant slowdowns.} + +\item{make_valid}{logical (default = \code{FALSE}). Whether to make geometries +valid before using them. Set \code{TRUE} if topology errors show up.} + +\item{combine_fragments}{logical. (default = \code{FALSE}). Whether to combine +geoms fragmented by the intersections as multipolygons based on the +\code{poly_ID} col. If \code{TRUE}, the operation may introduce \code{NA}s in the spatial +relationship information.} + +\item{dissolve}{logical. (default = \code{FALSE}). If \code{combine_fragments = TRUE}, +whether to also merge the multipolygon into a single polygon.} + +\item{return_table}{logical. (Default = \code{FALSE}) Overrides \code{return__object}. +If \code{TRUE}, return only the relationships as a \code{data.table}} + +\item{return_ids}{logical. (Default = \code{FALSE}) Overrides \code{return_gobject}. +If \code{TRUE}, return only the poly_IDs of the final entry in \code{filters}} + +\item{return_gobject}{logical. (Default = \verb{TRUE)}. Whether to return the new +set of polygons attached to the giotto object.} + +\item{verbose}{verbosity} +} +\value{ +\code{character} (IDs), \code{giottoPolygon}, or \code{giotto} depending on +\code{return_ids} and \code{return_gobject}. +} +\description{ +Select spatial geometries based on a list of spatial \code{filters}. +The final item in provided in the list is the layer of information +being queried.\cr +By default, results will be returned as a new polygon-based spatial unit +with selection information recorded in the associated cell metadata. \cr +Spatial queries may perform queries on the geometries themselves, so +\code{intersect()} operations are performed under the hood. For a lighter weight +option that just finds spatial relationships, see \code{\link[=relate]{relate()}} +} +\section{Functions}{ +\itemize{ +\item \code{spatQueryGiottoPolygons()}: deprecated alias. + +}} +\examples{ +g <- GiottoData::loadGiottoMini("vizgen") +pz0 <- getPolygonInfo(g, "z0") +boxgrid <- tessellate( + extent = ext(g), + shape = "square", + shape_size = 50, + name = "boxgrid" +) +hexarray <- tessellate( + extent = ext(g), + shape = "hexagon", + shape_size = 80, + name = "hexarray" +) +g <- setGiotto(g, boxgrid) +g <- setGiotto(g, hexarray) + +hex_ids <- sprintf("ID_\%d", c(1, 3, 6, 8, 17, 19, 23)) +box_ids <- sprintf("ID_\%d", c(12, 14, 15, 16, 22, 41, 44, 45, 51, 52, 62)) + +g <- spatQuery(g, + filters = list( + hexarray = hex_ids, + boxgrid = box_ids, + z0 = "all" + ), + return_gobject = TRUE +) +# extract polys since we attached it to the giotto object +qp <- g[[, "query_polys"]][[1]] + +qp2 <- spatQuery(g, + filters = list( + hexarray = hex_ids[3], + boxgrid = box_ids, + z0 = "all" + ), + buffer = c(hexarray = 150), + return_gobject = FALSE +) + +# check that extracted polys are being clipped as expected +plot(pz0) +plot(hexarray[hex_ids], border = "blue", add = TRUE) +plot(boxgrid[box_ids], add = TRUE, border = "red") +plot(qp, col = rainbow(20), add = TRUE) # selection by hex and box +plot(buffer(hexarray[hex_ids[3]], width = 150), add = TRUE) # buffered hex +plot(qp2, col = "black", add = TRUE) # selection by buffered hex and box + +# query for polys that fall within 100 units of a point +res <- spatQuery(g, + filters = list( + pts = c(6500, -4900), + z0 = "all" + ), + buffer = c(pts = 100), + return_gobject = FALSE, + make_valid = TRUE, + clip = FALSE +) + +pt_buffer <- buffer( + as.points(createSpatLocsObj(c(6500, -4900))), + 100 +) + +plot(pz0) +plot(pt_buffer, add = TRUE, border = "dodgerblue") # the selecting shape. +# note that clip = FALSE for this selection +plot(res, col = "red", add = TRUE) + +# only return the ids +ids <- spatQuery(g, + filters = list( + pts = c(6500, -4900), + z0 = "all" + ), + buffer = c(pts = 100), + return_ids = TRUE, + make_valid = TRUE +) +head(ids) +length(ids) + +# only return the table of relations +tab <- spatQuery(g, + filters = list( + hexarray = hex_ids, + boxgrid = box_ids, + z0 = "all" + ), + return_table = TRUE, + make_valid = TRUE +) +force(tab) + +} +\seealso{ +\code{\link[=relate]{relate()}} +} diff --git a/man/spatQueryGiottoPolygons.Rd b/man/spatQueryGiottoPolygons.Rd deleted file mode 100644 index 58f360ac..00000000 --- a/man/spatQueryGiottoPolygons.Rd +++ /dev/null @@ -1,43 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/spatial_query.R -\name{spatQueryGiottoPolygons} -\alias{spatQueryGiottoPolygons} -\title{Spatially query polygons within Giotto object} -\usage{ -spatQueryGiottoPolygons( - gobject, - filters, - name = "query_polys", - feat_type = NULL, - clip = TRUE -) -} -\arguments{ -\item{gobject}{Giotto object} - -\item{filters}{list of characters. Named list of IDs to query on as spatial -filters where the names designate the spatial unit to use and the character -values should either be 'all' or a vector of cell_IDs to use.} - -\item{name}{(optional) character. If not NULL, a new spatial unit of this -name will be generated from the results} - -\item{feat_type}{(optional) May be changed in future. Determines which -feature type metadata in which hierarchical selection information is stored.} - -\item{clip}{boolean. Default = FALSE. Whether final round of querying should -return polygons clipped by the polygons used to select them. If TRUE, a value -must be provided to \code{name} param to generate a new spatial unit} -} -\value{ -giottoPolygon -} -\description{ -Recursively select polygons based on a list of spatial filters. -Results will be returned as a new polygon-based spatial unit with selection -information recorded in the associated cell metadata. The final item in -provided in param \code{filters} is the layer of information being queried. -} -\seealso{ -\code{\link[=relate]{relate()}} -} diff --git a/man/spatialdataToGiotto.Rd b/man/spatialdataToGiotto.Rd index 1bbeda9b..6727304d 100644 --- a/man/spatialdataToGiotto.Rd +++ b/man/spatialdataToGiotto.Rd @@ -22,22 +22,25 @@ spatialdataToGiotto( \item{n_key_added}{equivalent of "key_added" argument from scanpy.pp.neighbors(). If multiple spatial networks are in the anndata object, a list of key_added terms may be provided. -If converting an anndata object from giottoToAnnData, a .txt file may be -provided, which was generated in that function, -i.e. \{spat_unit\}_\{feat_type\}_nn_network_keys_added.txt +If converting an anndata object from giottoToAnnData, the keys are saved in \code{.uns['NN_keys']} +and all keys are used in conversion unless specified in the function call. Cannot be "spatial". This becomes the name of the nearest network in the gobject.} \item{spatial_n_key_added}{equivalent of "key_added" argument from squidpy.gr.spatial_neighbors. If multiple spatial networks are in the anndata object, a list of key_added terms may be provided. -If converting an anndata object from giottoToAnnData, a .txt file may be -provided, which was generated in that function, -i.e. \{spat_unit\}_\{feat_type\}_spatial_network_keys_added.txt +If converting a SpatialData object from giottoToSpatialData, the keys are saved in \code{.uns['SN_keys']} +and all keys are used in conversion unless specified in the function call. Cannot be the same as n_key_added.} \item{delaunay_spat_net}{binary parameter for spatial network. If TRUE, the spatial network is a delaunay network.} +\item{spat_enrich_key_added}{list of names of spatial enrichment annotations added to the SpatialData object. +If converting an anndata object from giottoToAnnData and the original Giotto object had +spatial enrichment annotations, the keys are saved in \code{.uns['SE_keys']} +and all keys are used in conversion unless specified in the function call.} + \item{spat_unit}{desired spatial unit for conversion, default NULL} \item{feat_type}{desired feature type for conversion, default NULL} From 20562b87216dabb59ca771d36e50648c27fc1064 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Tue, 20 May 2025 17:24:24 -0400 Subject: [PATCH 26/45] chore: remove unused line --- R/aggregate.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/R/aggregate.R b/R/aggregate.R index 9a44744b..708718ec 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -681,9 +681,6 @@ setMethod( names(y) <- sprintf("channel_%d", seq_len(nchannel)) } - # NSE vars - coverage_fraction <- NULL - # subset polys if needed if (!is.null(poly_subset_ids)) { x <- x[x$poly_ID %in% poly_subset_ids] From 067005601ff07738f61d7832bd7be2350932a12c Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Mon, 16 Jun 2025 11:07:49 -0400 Subject: [PATCH 27/45] chore: docs --- R/methods-dims.R | 4 ++-- man/dims-generic.Rd | 6 ++++++ 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/R/methods-dims.R b/R/methods-dims.R index df2fce17..328c061e 100644 --- a/R/methods-dims.R +++ b/R/methods-dims.R @@ -146,10 +146,10 @@ setMethod("dim", signature("giottoPolygon"), function(x) dim(x[])) #' @export setMethod("dim", signature("giottoPoints"), function(x) dim(x[])) -#' @rdname dims_generic +#' @rdname dims-generic #' @export setMethod("dim", signature("overlapPointDT"), function(x) dim(x@data)) -#' @rdname dims_generic +#' @rdname dims-generic #' @export setMethod("dim", signature("overlapIntensityDT"), function(x) dim(x@data)) diff --git a/man/dims-generic.Rd b/man/dims-generic.Rd index ae95bd5e..54b719c3 100644 --- a/man/dims-generic.Rd +++ b/man/dims-generic.Rd @@ -24,6 +24,8 @@ \alias{dim,giottoLargeImage-method} \alias{dim,giottoPolygon-method} \alias{dim,giottoPoints-method} +\alias{dim,overlapPointDT-method} +\alias{dim,overlapIntensityDT-method} \title{Dimensions of giotto objects} \usage{ \S4method{nrow}{giotto}(x) @@ -69,6 +71,10 @@ \S4method{dim}{giottoPolygon}(x) \S4method{dim}{giottoPoints}(x) + +\S4method{dim}{overlapPointDT}(x) + +\S4method{dim}{overlapIntensityDT}(x) } \arguments{ \item{x}{object to check dimensions of} From 01e16abaff69f83a0adda0107c07642883db574c Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Mon, 16 Jun 2025 11:10:48 -0400 Subject: [PATCH 28/45] ci: update --- tests/testthat/test-aggregate.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R index ec683a61..05d37c90 100644 --- a/tests/testthat/test-aggregate.R +++ b/tests/testthat/test-aggregate.R @@ -20,7 +20,7 @@ random_points_gen <- function(n = 500, extent = ext(gpoly)) { ) } -g <- GiottoData::loadGiottoMini("vizgen") +g <- test_data$viz gpoly <- g[["spatial_info", "aggregate"]][[1]] gpoly@overlaps = NULL gpoly@spatVectorCentroids <- NULL From b786fbef67e0bd6a589b34c3a9383a78291e8a6e Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Mon, 16 Jun 2025 12:53:12 -0400 Subject: [PATCH 29/45] enh: ncol and nrow for new overlap objects --- R/aggregate.R | 12 ++++++------ R/methods-dims.R | 13 ++++++++++++- man/dims-generic.Rd | 12 ++++++++++++ 3 files changed, 30 insertions(+), 7 deletions(-) diff --git a/R/aggregate.R b/R/aggregate.R index 708718ec..caf1928a 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -427,8 +427,8 @@ setMethod( for (img_name in image_names) { if (!img_name %in% potential_large_image_names) { warning( - "image with the name ", img_name, - " was not found and will be skipped \n" + "[calculateOverlap] image with the name ", img_name, + " was not found and will be skipped \n", call. = FALSE ) } } @@ -1163,8 +1163,8 @@ calculateOverlapPolygonImages <- function(gobject, for (img_name in image_names) { if (!img_name %in% potential_large_image_names) { warning( - "image with the name ", img_name, - " was not found and will be skipped \n" + "[calculateOverlap] image with the name ", img_name, + " was not found and will be skipped \n", call. = FALSE ) } } @@ -1178,8 +1178,8 @@ calculateOverlapPolygonImages <- function(gobject, if (!img_name %in% potential_large_image_names) { warning( - "image with the name ", img_name, - " was not found and will be skipped \n" + "[calculateOverlap] image with the name ", img_name, + " was not found and will be skipped \n", call. = FALSE ) } diff --git a/R/methods-dims.R b/R/methods-dims.R index 328c061e..ee31ee3c 100644 --- a/R/methods-dims.R +++ b/R/methods-dims.R @@ -69,7 +69,13 @@ setMethod("nrow", signature("enrData"), function(x) nrow(x@enrichDT)) #' @export setMethod("nrow", signature("dimObj"), function(x) nrow(x@coordinates)) +#' @rdname dims-generic +#' @export +setMethod("nrow", signature("overlapPointDT"), function(x) nrow(x@data)) +#' @rdname dims-generic +#' @export +setMethod("nrow", signature("overlapIntensityDT"), function(x) nrow(x@data)) # ncol #### @@ -103,8 +109,13 @@ setMethod("ncol", signature("enrData"), function(x) ncol(x@enrichDT)) #' @export setMethod("ncol", signature("dimObj"), function(x) ncol(x@coordinates)) +#' @rdname dims-generic +#' @export +setMethod("ncol", signature("overlapPointDT"), function(x) ncol(x@data)) - +#' @rdname dims-generic +#' @export +setMethod("ncol", signature("overlapIntensityDT"), function(x) ncol(x@data)) ## dim() generic #### diff --git a/man/dims-generic.Rd b/man/dims-generic.Rd index 54b719c3..9d4817a2 100644 --- a/man/dims-generic.Rd +++ b/man/dims-generic.Rd @@ -11,11 +11,15 @@ \alias{nrow,spatialNetworkObj-method} \alias{nrow,enrData-method} \alias{nrow,dimObj-method} +\alias{nrow,overlapPointDT-method} +\alias{nrow,overlapIntensityDT-method} \alias{ncol,giotto-method} \alias{ncol,exprData-method} \alias{ncol,metaData-method} \alias{ncol,enrData-method} \alias{ncol,dimObj-method} +\alias{ncol,overlapPointDT-method} +\alias{ncol,overlapIntensityDT-method} \alias{dim,giotto-method} \alias{dim,spatLocsObj-method} \alias{dim,exprData-method} @@ -46,6 +50,10 @@ \S4method{nrow}{dimObj}(x) +\S4method{nrow}{overlapPointDT}(x) + +\S4method{nrow}{overlapIntensityDT}(x) + \S4method{ncol}{giotto}(x) \S4method{ncol}{exprData}(x) @@ -56,6 +64,10 @@ \S4method{ncol}{dimObj}(x) +\S4method{ncol}{overlapPointDT}(x) + +\S4method{ncol}{overlapIntensityDT}(x) + \S4method{dim}{giotto}(x) \S4method{dim}{spatLocsObj}(x) From 43c6e569fb285e8d6b9aeea7de75d35437bcb527 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Mon, 16 Jun 2025 13:08:37 -0400 Subject: [PATCH 30/45] enh: df coercion for overlapIntesityDT --- NAMESPACE | 1 + R/methods-coerce.R | 7 +++++++ man/as.data.table.Rd | 3 +++ 3 files changed, 11 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 3884c501..d16e5452 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,7 @@ S3method(.DollarNames,processParam) S3method(.DollarNames,spatEnrObj) S3method(.DollarNames,spatLocsObj) S3method(.DollarNames,terraVectData) +S3method(as.data.frame,overlapIntensityDT) S3method(as.data.frame,overlapPointDT) S3method(as.data.table,SpatVector) S3method(as.data.table,giottoPoints) diff --git a/R/methods-coerce.R b/R/methods-coerce.R index dd6b1862..83636ccd 100644 --- a/R/methods-coerce.R +++ b/R/methods-coerce.R @@ -161,6 +161,13 @@ as.data.frame.overlapPointDT <- function(x, ...) { ) } +#' @rdname as.data.table +#' @method as.data.frame overlapIntensityDT +#' @export +as.data.frame.overlapIntensityDT <- function(x, ...) { + x[] +} + # to matrix #### diff --git a/man/as.data.table.Rd b/man/as.data.table.Rd index f2e0dfe7..3b9e0169 100644 --- a/man/as.data.table.Rd +++ b/man/as.data.table.Rd @@ -6,6 +6,7 @@ \alias{as.data.table.giottoPolygon} \alias{as.data.table.giottoPoints} \alias{as.data.frame.overlapPointDT} +\alias{as.data.frame.overlapIntensityDT} \title{Coerce to data.table} \usage{ \method{as.data.table}{SpatVector}( @@ -22,6 +23,8 @@ \method{as.data.table}{giottoPoints}(x, ...) \method{as.data.frame}{overlapPointDT}(x, ...) + +\method{as.data.frame}{overlapIntensityDT}(x, ...) } \arguments{ \item{x}{The object to coerce} From 70ef2ab0c668f7c8353823e1e2701a9dd967bc90 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Mon, 16 Jun 2025 15:14:23 -0400 Subject: [PATCH 31/45] chore: improve docs for utility class --- NAMESPACE | 1 + R/classes.R | 65 +++++++++++++++++++++++ R/methods-extract.R | 6 +++ man/overlapPointDT-class.Rd | 100 ++++++++++++++++++++++++++++++++++++ 4 files changed, 172 insertions(+) create mode 100644 man/overlapPointDT-class.Rd diff --git a/NAMESPACE b/NAMESPACE index d16e5452..cf984daf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -300,6 +300,7 @@ exportClasses(giottoLargeImage) exportClasses(giottoPoints) exportClasses(giottoPolygon) exportClasses(nnNetObj) +exportClasses(overlapPointDT) exportClasses(processParam) exportClasses(spatEnrObj) exportClasses(spatLocsObj) diff --git a/R/classes.R b/R/classes.R index 80a9af90..e9b3148b 100644 --- a/R/classes.R +++ b/R/classes.R @@ -1579,6 +1579,71 @@ setClass("overlapInfo", setClass("overlapPoint", contains = c("overlapInfo", "VIRTUAL")) setClass("overlapIntensity", contains = c("overlapInfo", "VIRTUAL")) +#' @name overlapPointDT-class +#' @title Polygon and Point Relationships +#' @description +#' Utility class for storing overlaps relationships between polygons and points +#' in a sparse `data.table` format. Retrieve the unique ID index of overlapped +#' points `[i, ]`. Get indices of which polys are overlapping specific feature +#' species using `[, j]`. +#' +#' Subsetting with `ids = FALSE` and `[i, j]` indexing is also supported. +#' +#' Supports `as.matrix` for conversion to `dgCMatrix`. Contained poly and +#' feature names simplify rownames/colnames and empty row/col creation. +#' +#' @slot data data.table. Table containing 3 integer cols: +#' +#' * `poly` - polygon index. Maps to `spat_ids` slot. +#' * `feat` - feat_ID_uniq (unique integer identifier) of a point detection +#' * `feat_id_index` - index of feature name mapping in `@feat_ids` slot. +#' @slot spat_unit character. Spatial unit (usually name of polygons information) +#' @slot feat_type character. Feature type (usually name of points information) +#' @slot provenance character. provenance information +#' @slot spat_ids character. Polygon names +#' @slot feat_ids character. Feature names +#' @slot nfeats integer (optional metadata). How many feature points were +#' used in overlap operation. Gives an idea of sparsity, but has no effect on +#' processing. +#' +#' @param x object +#' @param i numeric, character, logical. Index of or name of poly in overlapping +#' polygons +#' @param j numeric, character, logical. Index of or name of feature being +#' overlapped. +#' @param use_names logical (default = `FALSE`). Whether to return as integer +#' indices or with character ids. +#' @param ids logical (default = `TRUE`). Whether to return the requested +#' integer indices (`TRUE`) or the subset overlap object (`FALSE`). +#' @param drop not used. +#' @param \dots additional params to pass (none implemented) +#' @returns integer or character if only `i` or `j` provided, depending on +#' `use_names`. A subset `overlapPointDT` if both `i` and `j` are used. +#' @examples +#' g <- GiottoData::loadGiottoMini("vizgen") +#' poly <- g[["spatial_info", "z0"]][[1]] +#' ovlp <- overlaps(poly, "rna") +#' ovlp +#' +#' as.matrix(ovlp) +#' +#' dim(ovlp) +#' nrow(ovlp) # number of relationships +#' +#' # get feature unique IDs overlapped by nth poly +#' ovlp[1] # check one (no overlaps returns integer(0)) +#' ovlp[1:5] # check multiple +#' ovlp[1:5, use_names = TRUE] # returns feature names, but no longer unique +#' +#' # get integer index of poly(s) overlapping particular feature species +#' ovlp[, 1] +#' ovlp[, "Mlc1"] # this is the same +#' +#' # get a subset of overlap object +#' ovlp[1:10, ids = FALSE] # subset to first 10 polys +#' ovlp[, 1:10, ids = FALSE] # subset to first 10 feature species +#' ovlp[1:10, 1:10] # subset to first 10 polys and first 10 features species +#' @exportClass overlapPointDT setClass("overlapPointDT", contains = "overlapPoint", slots = list( diff --git a/R/methods-extract.R b/R/methods-extract.R index 4073d62f..3417a503 100644 --- a/R/methods-extract.R +++ b/R/methods-extract.R @@ -1281,6 +1281,8 @@ setMethod( # * overlapPointDT #### +#' @rdname overlapPointDT-class +#' @export setMethod("[", signature( x = "overlapPointDT", @@ -1296,6 +1298,8 @@ setMethod("[", } ) +#' @rdname overlapPointDT-class +#' @export setMethod("[", signature( x = "overlapPointDT", @@ -1311,6 +1315,8 @@ setMethod("[", } ) +#' @rdname overlapPointDT-class +#' @export setMethod("[", signature( x = "overlapPointDT", diff --git a/man/overlapPointDT-class.Rd b/man/overlapPointDT-class.Rd new file mode 100644 index 00000000..57e8ceee --- /dev/null +++ b/man/overlapPointDT-class.Rd @@ -0,0 +1,100 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/classes.R, R/methods-extract.R +\docType{class} +\name{overlapPointDT-class} +\alias{overlapPointDT-class} +\alias{[,overlapPointDT,gIndex,missing,missing-method} +\alias{[,overlapPointDT,missing,gIndex,missing-method} +\alias{[,overlapPointDT,gIndex,gIndex,missing-method} +\title{Polygon and Point Relationships} +\usage{ +\S4method{[}{overlapPointDT,gIndex,missing,missing}(x, i, j, ..., use_names = FALSE, ids = TRUE, drop) + +\S4method{[}{overlapPointDT,missing,gIndex,missing}(x, i, j, ..., use_names = FALSE, ids = TRUE, drop) + +\S4method{[}{overlapPointDT,gIndex,gIndex,missing}(x, i, j, ..., use_names = FALSE, drop) +} +\arguments{ +\item{x}{object} + +\item{i}{numeric, character, logical. Index of or name of poly in overlapping +polygons} + +\item{j}{numeric, character, logical. Index of or name of feature being +overlapped.} + +\item{\dots}{additional params to pass (none implemented)} + +\item{use_names}{logical (default = \code{FALSE}). Whether to return as integer +indices or with character ids.} + +\item{ids}{logical (default = \code{TRUE}). Whether to return the requested +integer indices (\code{TRUE}) or the subset overlap object (\code{FALSE}).} + +\item{drop}{not used.} +} +\value{ +integer or character if only \code{i} or \code{j} provided, depending on +\code{use_names}. A subset \code{overlapPointDT} if both \code{i} and \code{j} are used. +} +\description{ +Utility class for storing overlaps relationships between polygons and points +in a sparse \code{data.table} format. Retrieve the unique ID index of overlapped +points \verb{[i, ]}. Get indices of which polys are overlapping specific feature +species using \verb{[, j]}. + +Subsetting with \code{ids = FALSE} and \verb{[i, j]} indexing is also supported. + +Supports \code{as.matrix} for conversion to \code{dgCMatrix}. Contained poly and +feature names simplify rownames/colnames and empty row/col creation. +} +\section{Slots}{ + +\describe{ +\item{\code{data}}{data.table. Table containing 3 integer cols: +\itemize{ +\item \code{poly} - polygon index. Maps to \code{spat_ids} slot. +\item \code{feat} - feat_ID_uniq (unique integer identifier) of a point detection +\item \code{feat_id_index} - index of feature name mapping in \verb{@feat_ids} slot. +}} + +\item{\code{spat_unit}}{character. Spatial unit (usually name of polygons information)} + +\item{\code{feat_type}}{character. Feature type (usually name of points information)} + +\item{\code{provenance}}{character. provenance information} + +\item{\code{spat_ids}}{character. Polygon names} + +\item{\code{feat_ids}}{character. Feature names} + +\item{\code{nfeats}}{integer (optional metadata). How many feature points were +used in overlap operation. Gives an idea of sparsity, but has no effect on +processing.} +}} + +\examples{ +g <- GiottoData::loadGiottoMini("vizgen") +poly <- g[["spatial_info", "z0"]][[1]] +ovlp <- overlaps(poly, "rna") +ovlp + +as.matrix(ovlp) + +dim(ovlp) +nrow(ovlp) # number of relationships + +# get feature unique IDs overlapped by nth poly +ovlp[1] # check one (no overlaps returns integer(0)) +ovlp[1:5] # check multiple +ovlp[1:5, use_names = TRUE] # returns feature names, but no longer unique + +# get integer index of poly(s) overlapping particular feature species +ovlp[, 1] +ovlp[, "Mlc1"] # this is the same + +# get a subset of overlap object +ovlp[1:10, ids = FALSE] # subset to first 10 polys +ovlp[, 1:10, ids = FALSE] # subset to first 10 feature species +ovlp[1:10, 1:10] # subset to first 10 polys and first 10 features species +} From e19c0901e8cb397dfa591533acabbd3432af0136 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Fri, 19 Dec 2025 14:12:16 -0500 Subject: [PATCH 32/45] change: overlap handling during gpoly rbind These calculated values are now removed, which makes the most sense since they are derived values. Message is included to ask to recalculate the overlap info if needed. --- R/methods-rbind.R | 36 +++++++++++++----------------------- 1 file changed, 13 insertions(+), 23 deletions(-) diff --git a/R/methods-rbind.R b/R/methods-rbind.R index e19969be..51f8d1b4 100644 --- a/R/methods-rbind.R +++ b/R/methods-rbind.R @@ -207,10 +207,9 @@ rbind2_giotto_polygon_homo <- function(x, y) { ) } - if (is.null(slot(x, "overlaps"))) { - slot(x, "overlaps") <- slot(y, "overlaps") - } else { - slot(x, "overlaps") <- rbind(slot(x, "overlaps"), slot(y, "overlaps")) + if (!is.null(slot(x, "overlaps")) || !is.null(slot(y, "overlaps"))) { + .rbind2_giotto_polygon_overlap_message() + slot(x, "overlaps") <- NULL } slot(x, "unique_ID_cache") <- unique(c(spatIDs(x), spatIDs(y))) @@ -238,7 +237,8 @@ rbind2_giotto_polygon_hetero <- function(x, y, new_name, add_list_ID = TRUE) { return(gpoly) } - null_xsv <- null_xsvc <- null_xovlp <- FALSE + # init flags + null_xsv <- null_xsvc <- FALSE # Add list_ID if (!is.null(slot(x, "spatVector"))) { @@ -267,19 +267,6 @@ rbind2_giotto_polygon_hetero <- function(x, y, new_name, add_list_ID = TRUE) { } } - if (!is.null(slot(x, "overlaps"))) { - if (!"list_ID" %in% names(slot(x, "overlaps"))) { - slot(x, "overlaps")$list_ID <- slot(x, "name") - } - } else { - null_xovlp <- TRUE - } - if (!is.null(y@overlaps)) { - if (!"list_ID" %in% names(slot(y, "overlaps"))) { - slot(y, "overlaps")$list_ID <- slot(y, "name") - } - } - # Perform rbinds if (isTRUE(null_xsv)) { new_sv <- slot(y, "spatVector") @@ -296,18 +283,21 @@ rbind2_giotto_polygon_hetero <- function(x, y, new_name, add_list_ID = TRUE) { ) } - if (isTRUE(null_xovlp)) { - new_ovlp <- slot(y, "overlaps") - } else { - new_ovlp <- rbind(slot(x, "overlaps"), slot(y, "overlaps")) + if (!is.null(slot(x, "overlaps")) || !is.null(slot(y, "overlaps"))) { + .rbind2_giotto_polygon_overlap_message() } new_poly <- create_giotto_polygon_object( name = new_name, spatVector = new_sv, spatVectorCentroids = new_svc, - overlaps = new_ovlp, + overlaps = NULL, unique_IDs = unique(c(spatIDs(x), spatIDs(y))) ) new_poly } + +.rbind2_giotto_polygon_overlap_message <- function() { + vmsg("[rbind giottoPolygon] Overlap information removed. + Please recalculate with calculateOverlap() if needed.") +} From 4b43b240c3e445646ac693226a25d0868dcdef82 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Fri, 19 Dec 2025 16:26:28 -0500 Subject: [PATCH 33/45] change: default point overlap method -> vector Also make this settable via global option. --- R/aggregate.R | 13 +++++++++++-- R/zzz.R | 1 + 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/R/aggregate.R b/R/aggregate.R index d75bcdd9..c0d5408e 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -737,6 +737,15 @@ setMethod( # * SpatVector SpatVector #### #' @rdname calculateOverlap +#' @param method character. One of `"vector"` or `"raster"`, +#' (default = `"vector"`). Method for polygon-point feature overlap calculation. +#' Can also set as an option: `"giotto.overlap_point_method"` +#' +#' * `"vector"` uses direct spatial extraction (more accurate to input geometry, +#' will double count features in overlapping polygon regions for all overlapping +#' polygons). +#' * `"raster"` uses rasterization (faster, assigns each feature to only one +#' polygon even in overlapping regions as a byproduct of the rasterization). #' @export setMethod( "calculateOverlap", signature(x = "SpatVector", y = "SpatVector"), @@ -745,11 +754,11 @@ setMethod( feat_subset_column = NULL, feat_subset_values = NULL, feat_count_column = NULL, - method = c("raster", "vector"), + method = getOption("giotto.overlap_point_method", "vector"), verbose = TRUE, feat_subset_ids = deprecated(), count_info_column = deprecated()) { - method <- match.arg(method, choices = c("raster", "vector")) + method <- match.arg(method, choices = c("vector", "raster")) feat_subset_values <- GiottoUtils::deprecate_param( feat_subset_ids, feat_subset_values, fun = "calculateOverlap", when = "0.4.7" diff --git a/R/zzz.R b/R/zzz.R index ff2c7c1a..588d8d60 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -15,4 +15,5 @@ init_option("giotto.update_param", TRUE) init_option("giotto.no_python_warn", FALSE) init_option("giotto.init_check_severity", "stop") + init_option("giotto.overlap_point_method", "vector") } From 776324e9ead7f34492752ac59949df8b5c0810b4 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Fri, 19 Dec 2025 16:26:41 -0500 Subject: [PATCH 34/45] chore: docs --- man/calculateOverlap.Rd | 17 +++++++++++++++-- man/overlapToMatrix.Rd | 4 +++- 2 files changed, 18 insertions(+), 3 deletions(-) diff --git a/man/calculateOverlap.Rd b/man/calculateOverlap.Rd index 988be0de..6753e46d 100644 --- a/man/calculateOverlap.Rd +++ b/man/calculateOverlap.Rd @@ -85,7 +85,7 @@ feat_subset_column = NULL, feat_subset_values = NULL, feat_count_column = NULL, - method = c("raster", "vector"), + method = getOption("giotto.overlap_point_method", "vector"), verbose = TRUE, feat_subset_ids = deprecated(), count_info_column = deprecated() @@ -124,7 +124,9 @@ in \code{feat_subset_column} in order to subset feature points when performing overlap calculation.} \item{feat_count_column}{character. (optional) column with count information. -Useful in cases when more than one detection is reported per point.} +Useful in cases when more than one detection is reported per point. If a +column called "count" is present in the feature points data, it will be +automatically selected.} \item{return_gpolygon}{default = TRUE. Whether to return the entire giottoPolygon provided to \code{x}, but with the overlaps information appended or @@ -133,6 +135,17 @@ as a bare terra \code{SpatVector}} \item{feat_subset_ids}{deprecated. Use \code{feat_subset_values} instead.} \item{count_info_column}{deprecated. Use \code{feat_count_column} instead.} + +\item{method}{character. One of \code{"vector"} or \code{"raster"}, +(default = \code{"vector"}). Method for polygon-point feature overlap calculation. +Can also set as an option: \code{"giotto.overlap_point_method"} +\itemize{ +\item \code{"vector"} uses direct spatial extraction (more accurate to input geometry, +will double count features in overlapping polygon regions for all overlapping +polygons). +\item \code{"raster"} uses rasterization (faster, assigns each feature to only one +polygon even in overlapping regions as a byproduct of the rasterization). +}} } \value{ Usually an object of the same class as \code{x}, with the overlaps diff --git a/man/overlapToMatrix.Rd b/man/overlapToMatrix.Rd index 8497b8af..84967848 100644 --- a/man/overlapToMatrix.Rd +++ b/man/overlapToMatrix.Rd @@ -83,7 +83,9 @@ points or data.table of overlaps generated from \code{calculateOverlap}} \item{type}{character. Type of overlap data (either 'point' or 'intensity')} -\item{feat_count_column}{column with count information} +\item{feat_count_column}{column with count information. If a +column called "count" is present in the feature points data, it will be +automatically selected.} \item{fun}{character. Function to aggregate image information (default = "sum")} From aa15e9cdfe17c3f10bff3787db539dd840f8a419 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Mon, 22 Dec 2025 10:30:38 -0500 Subject: [PATCH 35/45] fix test for new vector overlap default --- tests/testthat/test-aggregate.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R index 05d37c90..9da31052 100644 --- a/tests/testthat/test-aggregate.R +++ b/tests/testthat/test-aggregate.R @@ -34,15 +34,13 @@ img <- imglist[[1]] # these tests can change if the source test dataset changes test_that("calculateOverlap works for points", { - res_rast <- calculateOverlap(gpoly, gpts, verbose = FALSE) + res_rast <- calculateOverlap(gpoly, gpts, verbose = FALSE, method = "raster") expect_identical(names(res_rast@overlaps), "rna") ovlp_rast <- overlaps(res_rast, "rna") checkmate::expect_class(ovlp_rast, "overlapInfo") expect_equal(nrow(ovlp_rast@data), 12383) expect_identical(as.numeric(ovlp_rast@data[100,]), c(385, 685, 12)) - res_vect <- calculateOverlap(gpoly, gpts, - verbose = FALSE, method = "vector" - ) + res_vect <- calculateOverlap(gpoly, gpts, verbose = FALSE, method = "vector") # larger due to double counts being possible with vector method ovlp_vect <- overlaps(res_vect, "rna") From df09a055c312c17e1047d616db99c6469b42b419 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Sun, 28 Dec 2025 14:14:15 -0500 Subject: [PATCH 36/45] fix: raster aggregate count col --- R/aggregate.R | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/R/aggregate.R b/R/aggregate.R index c0d5408e..ad7525af 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -794,7 +794,7 @@ setMethod( "raster" = .calculate_overlap_raster( spatvec = x, pointvec = y, - count_info_column = feat_count_column, + keep = feat_count_column, verbose = verbose ), "vector" = .calculate_overlap_vector( @@ -818,12 +818,14 @@ setMethod( checkmate::assert_character(keep, null.ok = TRUE) res <- terra::extract(spatvec, pointvec) cn <- colnames(res) + # keep only spat relation info from extract if (all(c("id.y", "poly_ID") %in% cn)) { res_keep <- c("id.y", "poly_ID") } else { res_keep <- cn[c(1L, 2L)] } res <- res[!is.na(res[[2]]), res_keep] # drop NAs (sparsify) + col select + # get any needed attributes for `keep` and append them to relations info if (!is.null(keep)) { feat_keep <- do.call( data.frame, terra::as.list(pointvec[][res[[1]], keep]) @@ -1045,7 +1047,7 @@ calculateOverlapRaster <- function( #' performs rasterization of the polys and then checks for overlaps. #' @param spatvec `SpatVector` polygon from a `giottoPolygon` object #' @param pointvec `SpatVector` points from a `giottoPoints` object -#' @param count_info_column column with count information (optional) +#' @param keep column(s) to keep #' @param verbose be verbose #' @concept overlap #' @returns `SpatVector` of overlapped points info @@ -1053,11 +1055,10 @@ calculateOverlapRaster <- function( #' @keywords internal .calculate_overlap_raster <- function(spatvec, pointvec, - count_info_column = NULL, + keep = NULL, verbose = TRUE) { # DT vars poly_ID <- poly_i <- ID <- x <- y <- feat_ID <- feat_ID_uniq <- NULL - # spatial vector to raster if (verbose) GiottoUtils::wrap_msg("1. convert polygon to raster \n") spatrast_res <- polygon_to_raster(spatvec, field = "poly_ID") @@ -1066,9 +1067,17 @@ calculateOverlapRaster <- function( ## overlap between raster and point if (verbose) GiottoUtils::wrap_msg("2. overlap raster and points \n") - overlap_res <- terra::extract(x = spatrast, y = pointvec) + res <- terra::extract(x = spatrast, y = pointvec) + res <- res[!is.na(res[[2]]),] # drop NAs (sparsify extracted relations) + + if (!is.null(keep)) { + feat_keep <- do.call( + data.frame, terra::as.list(pointvec[][res[[1]], keep]) + ) # list of vectors + res <- cbind(res, feat_keep) + } - return(overlap_res) + return(res) } From 55393be4201f2c8ac6284c2facd04b8d667967ff Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Sun, 28 Dec 2025 14:14:39 -0500 Subject: [PATCH 37/45] fix: aggregation testing: points count gen make counts col optional --- tests/testthat/test-aggregate.R | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R index 9da31052..c1d6766f 100644 --- a/tests/testthat/test-aggregate.R +++ b/tests/testthat/test-aggregate.R @@ -8,16 +8,19 @@ random_pts_names <- function(n, species = 20) { sample(nameset, replace = TRUE, size = n, prob = runif(species)) } -random_points_gen <- function(n = 500, extent = ext(gpoly)) { +random_points_gen <- function(n = 500, extent = ext(gpoly), count = TRUE) { GiottoUtils::local_seed(1234) evect <- as.numeric(ext(extent)[]) - count <- abs(round(rnorm(n, 0, sd = 0.8))) + 1 - data.table::data.table( + d <- data.table::data.table( id = random_pts_names(n), x = runif(n, min = evect[[1]], max = evect[[2]]), - y = runif(n, min = evect[[3]], max = evect[[4]]), - count = count + y = runif(n, min = evect[[3]], max = evect[[4]]) ) + if (count) { + count <- abs(round(rnorm(n, 0, sd = 0.8))) + 1 + d[, count := count] + } + d } g <- test_data$viz From e9e8367ccbf5306b2bc17fbde10d268196dbf6ae Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Sun, 28 Dec 2025 14:18:50 -0500 Subject: [PATCH 38/45] chore: reorganize for clarity --- R/aggregate.R | 77 +++++++++++++++++++++++++-------------------------- 1 file changed, 38 insertions(+), 39 deletions(-) diff --git a/R/aggregate.R b/R/aggregate.R index ad7525af..4b6dc49a 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -836,6 +836,44 @@ setMethod( } +#' @name .calculate_overlap_raster +#' @title Find feature points overlapped by rasterized polygon. +#' @description Core workflow function that accepts simple `SpatVector` inputs, +#' performs rasterization of the polys and then checks for overlaps. +#' @param spatvec `SpatVector` polygon from a `giottoPolygon` object +#' @param pointvec `SpatVector` points from a `giottoPoints` object +#' @param keep column(s) to keep +#' @param verbose be verbose +#' @concept overlap +#' @returns `SpatVector` of overlapped points info +#' @seealso [calculateOverlapRaster()] +#' @keywords internal +.calculate_overlap_raster <- function(spatvec, + pointvec, + keep = NULL, + verbose = TRUE) { + # DT vars + poly_ID <- poly_i <- ID <- x <- y <- feat_ID <- feat_ID_uniq <- NULL + # spatial vector to raster + if (verbose) GiottoUtils::wrap_msg("1. convert polygon to raster \n") + spatrast_res <- polygon_to_raster(spatvec, field = "poly_ID") + spatrast <- spatrast_res[["raster"]] + ID_vector <- spatrast_res[["ID_vector"]] + + ## overlap between raster and point + if (verbose) GiottoUtils::wrap_msg("2. overlap raster and points \n") + res <- terra::extract(x = spatrast, y = pointvec) + res <- res[!is.na(res[[2]]),] # drop NAs (sparsify extracted relations) + + if (!is.null(keep)) { + feat_keep <- do.call( + data.frame, terra::as.list(pointvec[][res[[1]], keep]) + ) # list of vectors + res <- cbind(res, feat_keep) + } + + return(res) +} @@ -1041,45 +1079,6 @@ calculateOverlapRaster <- function( odt } -#' @name .calculate_overlap_raster -#' @title Find feature points overlapped by rasterized polygon. -#' @description Core workflow function that accepts simple `SpatVector` inputs, -#' performs rasterization of the polys and then checks for overlaps. -#' @param spatvec `SpatVector` polygon from a `giottoPolygon` object -#' @param pointvec `SpatVector` points from a `giottoPoints` object -#' @param keep column(s) to keep -#' @param verbose be verbose -#' @concept overlap -#' @returns `SpatVector` of overlapped points info -#' @seealso [calculateOverlapRaster()] -#' @keywords internal -.calculate_overlap_raster <- function(spatvec, - pointvec, - keep = NULL, - verbose = TRUE) { - # DT vars - poly_ID <- poly_i <- ID <- x <- y <- feat_ID <- feat_ID_uniq <- NULL - # spatial vector to raster - if (verbose) GiottoUtils::wrap_msg("1. convert polygon to raster \n") - spatrast_res <- polygon_to_raster(spatvec, field = "poly_ID") - spatrast <- spatrast_res[["raster"]] - ID_vector <- spatrast_res[["ID_vector"]] - - ## overlap between raster and point - if (verbose) GiottoUtils::wrap_msg("2. overlap raster and points \n") - res <- terra::extract(x = spatrast, y = pointvec) - res <- res[!is.na(res[[2]]),] # drop NAs (sparsify extracted relations) - - if (!is.null(keep)) { - feat_keep <- do.call( - data.frame, terra::as.list(pointvec[][res[[1]], keep]) - ) # list of vectors - res <- cbind(res, feat_keep) - } - - return(res) -} - #' @title Overlap points -- single polygon From 6149adb9ab8e9ed1cb8425eee0722d290316afd7 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Tue, 30 Dec 2025 02:14:30 -0500 Subject: [PATCH 39/45] refactor: point extraction --- R/aggregate.R | 37 +++++++++++++++---------------------- 1 file changed, 15 insertions(+), 22 deletions(-) diff --git a/R/aggregate.R b/R/aggregate.R index 4b6dc49a..dfa0a297 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -815,24 +815,7 @@ setMethod( #' @keywords internal #' @noRd .calculate_overlap_vector <- function(spatvec, pointvec, keep = NULL) { - checkmate::assert_character(keep, null.ok = TRUE) - res <- terra::extract(spatvec, pointvec) - cn <- colnames(res) - # keep only spat relation info from extract - if (all(c("id.y", "poly_ID") %in% cn)) { - res_keep <- c("id.y", "poly_ID") - } else { - res_keep <- cn[c(1L, 2L)] - } - res <- res[!is.na(res[[2]]), res_keep] # drop NAs (sparsify) + col select - # get any needed attributes for `keep` and append them to relations info - if (!is.null(keep)) { - feat_keep <- do.call( - data.frame, terra::as.list(pointvec[][res[[1]], keep]) - ) # list of vectors - res <- cbind(res, feat_keep) - } - res + .terra_extract(x = spatvec, y = pointvec, keep = keep) } @@ -862,21 +845,31 @@ setMethod( ## overlap between raster and point if (verbose) GiottoUtils::wrap_msg("2. overlap raster and points \n") - res <- terra::extract(x = spatrast, y = pointvec) + .terra_extract(x = spatrast, y = pointvec, keep = keep) +} + +# x is segmentation, y is point +# keep is additional cols of point metadata to keep +# assume output first two cols from `terra::extract()` are: +# (1) point idx, (2) poly idx +# additional cols (if any) are poly or mask attributes and they will be dropped +.terra_extract <- function(x, y, keep, ...) { + checkmate::assert_character(keep, null.ok = TRUE) + res <- terra::extract(x, y, ...)[, 1L:2L] + # 2nd cols can have NA values. NAs denote points that are not overlapped res <- res[!is.na(res[[2]]),] # drop NAs (sparsify extracted relations) + # get any needed attributes for `keep` and append them to relations info if (!is.null(keep)) { feat_keep <- do.call( - data.frame, terra::as.list(pointvec[][res[[1]], keep]) + data.frame, terra::as.list(y[][res[[1]], keep]) ) # list of vectors res <- cbind(res, feat_keep) } - return(res) } - #' @title calculateOverlapRaster #' @name calculateOverlapRaster #' @description calculate overlap between cellular structures (polygons) and From 6cfd6fd6009883d909cf7f6ec16d4f713b6c285f Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Tue, 30 Dec 2025 15:37:20 -0500 Subject: [PATCH 40/45] chore: update tests --- tests/testthat/test-aggregate.R | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R index c1d6766f..d2fe42f8 100644 --- a/tests/testthat/test-aggregate.R +++ b/tests/testthat/test-aggregate.R @@ -37,29 +37,29 @@ img <- imglist[[1]] # these tests can change if the source test dataset changes test_that("calculateOverlap works for points", { + # counts info now automatically included if a `count` column is available + # in points input + + # 1. test raster method res_rast <- calculateOverlap(gpoly, gpts, verbose = FALSE, method = "raster") expect_identical(names(res_rast@overlaps), "rna") ovlp_rast <- overlaps(res_rast, "rna") checkmate::expect_class(ovlp_rast, "overlapInfo") expect_equal(nrow(ovlp_rast@data), 12383) - expect_identical(as.numeric(ovlp_rast@data[100,]), c(385, 685, 12)) + expect_identical(as.numeric(ovlp_rast@data[100,]), c(385, 685, 12, 2)) + + # 2. test vector method (default) res_vect <- calculateOverlap(gpoly, gpts, verbose = FALSE, method = "vector") - # larger due to double counts being possible with vector method ovlp_vect <- overlaps(res_vect, "rna") expect_equal(nrow(ovlp_vect@data), 12311) - expect_identical(as.numeric(ovlp_vect@data[100,]), c(12, 671, 3)) + expect_identical(as.numeric(ovlp_vect@data[100,]), c(12, 671, 3, 2)) - # with counts info - res_vect_cts <- calculateOverlap(gpoly, gpts, - feat_count_column = "count", verbose = FALSE, method = "vector" - ) - ovlp_vect_cts <- overlaps(res_vect_cts, "rna") + # 3. check expected col names in output expect_identical( - names(ovlp_vect_cts@data), + names(ovlp_vect@data), c("poly", "feat", "feat_id_index", "count") ) - expect_identical(as.numeric(ovlp_vect_cts@data[100,]), c(12, 671, 3, 2)) }) test_that("calculateOverlap works for basic images", { From 475daa5c263f4eab896ba98610f7ee90757375a5 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Tue, 30 Dec 2025 20:19:06 -0500 Subject: [PATCH 41/45] fixes --- R/aggregate.R | 2 +- tests/testthat/test-aggregate.R | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/R/aggregate.R b/R/aggregate.R index dfa0a297..56d319e1 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -975,7 +975,7 @@ calculateOverlapRaster <- function( overlap_points <- .calculate_overlap_raster( spatvec = spatvec, pointvec = pointvec, - count_info_column = feat_count_column, + keep = feat_count_column, verbose = verbose ) diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R index d2fe42f8..35f0f1f6 100644 --- a/tests/testthat/test-aggregate.R +++ b/tests/testthat/test-aggregate.R @@ -94,7 +94,8 @@ test_that("calculateOverlap works for affine images", { test_that("overlapToMatrix works for point overlaps", { res_vect <- calculateOverlap(gpoly, gpts, verbose = FALSE, - method = "vector" + method = "vector", + feat_count_column = NULL ) ovlp_vect <- overlaps(res_vect, "rna") expect_identical(names(ovlp_vect@data), From 55a4253ec48cc02c37ec23c4e6796e70033fb354 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Wed, 31 Dec 2025 04:26:07 -0500 Subject: [PATCH 42/45] Update aggregate.R --- R/aggregate.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/aggregate.R b/R/aggregate.R index 56d319e1..3e0e6e28 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -770,9 +770,7 @@ setMethod( checkmate::assert_true(terra::is.polygons(x)) checkmate::assert_true(terra::is.points(y)) # TODO allow another poly? - if (!is.null(poly_subset_ids)) { - checkmate::assert_character(poly_subset_ids) - } + checkmate::assert_character(poly_subset_ids, null.ok = TRUE) # subset points and polys if needed # * subset x From f976dcce0ae2307fdf71ddaeb061288d2ebcf16e Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Wed, 31 Dec 2025 05:12:56 -0500 Subject: [PATCH 43/45] Update test-aggregate.R --- tests/testthat/test-aggregate.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R index 35f0f1f6..509b2779 100644 --- a/tests/testthat/test-aggregate.R +++ b/tests/testthat/test-aggregate.R @@ -95,7 +95,7 @@ test_that("overlapToMatrix works for point overlaps", { res_vect <- calculateOverlap(gpoly, gpts, verbose = FALSE, method = "vector", - feat_count_column = NULL + feat_count_column = FALSE # override autodetect of "count" col ) ovlp_vect <- overlaps(res_vect, "rna") expect_identical(names(ovlp_vect@data), From bc4eebc6c4bfd9a1311cd29d55826a0505c3acf7 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Wed, 31 Dec 2025 14:30:58 -0500 Subject: [PATCH 44/45] chore: docs --- R/aggregate.R | 4 +--- man/dot-calculate_overlap_raster.Rd | 9 ++------- man/overlapToMatrix.Rd | 5 ++--- 3 files changed, 5 insertions(+), 13 deletions(-) diff --git a/R/aggregate.R b/R/aggregate.R index 3e0e6e28..8c286bf6 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -1697,14 +1697,13 @@ setMethod( # * giottoPolygon #### #' @rdname overlapToMatrix -#' @param output data format/class to return the results as +#' @param output data format/class to return the results as. Default is "Matrix" #' @export setMethod( "overlapToMatrix", signature("giottoPolygon"), function(x, feat_info = "rna", type = c("point", "intensity"), feat_count_column = NULL, - output = c("Matrix", "data.table"), count_info_column = deprecated(), ...) { # deprecations @@ -1731,7 +1730,6 @@ setMethod( argslist <- list( x = overlaps_data, feat_count_column = feat_count_column, - output = output, ... ) diff --git a/man/dot-calculate_overlap_raster.Rd b/man/dot-calculate_overlap_raster.Rd index d4dc38b0..3caec6fb 100644 --- a/man/dot-calculate_overlap_raster.Rd +++ b/man/dot-calculate_overlap_raster.Rd @@ -4,19 +4,14 @@ \alias{.calculate_overlap_raster} \title{Find feature points overlapped by rasterized polygon.} \usage{ -.calculate_overlap_raster( - spatvec, - pointvec, - count_info_column = NULL, - verbose = TRUE -) +.calculate_overlap_raster(spatvec, pointvec, keep = NULL, verbose = TRUE) } \arguments{ \item{spatvec}{\code{SpatVector} polygon from a \code{giottoPolygon} object} \item{pointvec}{\code{SpatVector} points from a \code{giottoPoints} object} -\item{count_info_column}{column with count information (optional)} +\item{keep}{column(s) to keep} \item{verbose}{be verbose} } diff --git a/man/overlapToMatrix.Rd b/man/overlapToMatrix.Rd index 84967848..5d6af34f 100644 --- a/man/overlapToMatrix.Rd +++ b/man/overlapToMatrix.Rd @@ -31,7 +31,6 @@ feat_info = "rna", type = c("point", "intensity"), feat_count_column = NULL, - output = c("Matrix", "data.table"), count_info_column = deprecated(), ... ) @@ -102,13 +101,13 @@ automatically selected.} \item{\dots}{additional params to pass to methods} -\item{output}{data format/class to return the results as} - \item{col_names, row_names}{character vector. (optional) Set of row and col names that are expected to exist. This fixes the dimensions of the matrix since the overlaps information does not directly report rows and cols where no values were detected.} +\item{output}{data format/class to return the results as. Default is "Matrix"} + \item{sort}{logical (default = TRUE). Whether to perform a mixed sort on output matrix row and col names.} } From 8bee86a15d086fd3300e5f63bd0c943bed4d6f54 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Wed, 31 Dec 2025 14:31:03 -0500 Subject: [PATCH 45/45] test fixes --- tests/testthat/test-aggregate.R | 42 ++++++++++++++++++++++++++------- 1 file changed, 34 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-aggregate.R b/tests/testthat/test-aggregate.R index 509b2779..27de3c9d 100644 --- a/tests/testthat/test-aggregate.R +++ b/tests/testthat/test-aggregate.R @@ -11,14 +11,14 @@ random_pts_names <- function(n, species = 20) { random_points_gen <- function(n = 500, extent = ext(gpoly), count = TRUE) { GiottoUtils::local_seed(1234) evect <- as.numeric(ext(extent)[]) + cts <- abs(round(rnorm(n, 0, sd = 0.8))) + 1 d <- data.table::data.table( id = random_pts_names(n), x = runif(n, min = evect[[1]], max = evect[[2]]), y = runif(n, min = evect[[3]], max = evect[[4]]) ) if (count) { - count <- abs(round(rnorm(n, 0, sd = 0.8))) + 1 - d[, count := count] + d[, count := cts] } d } @@ -27,7 +27,10 @@ g <- test_data$viz gpoly <- g[["spatial_info", "aggregate"]][[1]] gpoly@overlaps = NULL gpoly@spatVectorCentroids <- NULL -gpts <- createGiottoPoints(random_points_gen(80000), verbose = FALSE) +gpts <- createGiottoPoints(random_points_gen(80000, count = FALSE), + verbose = FALSE) +gpts_cts <- createGiottoPoints(random_points_gen(80000, count = TRUE), + verbose = FALSE) imglist <- g[["images",]] img <- imglist[[1]] @@ -37,11 +40,34 @@ img <- imglist[[1]] # these tests can change if the source test dataset changes test_that("calculateOverlap works for points", { + # [NO COUNTS] + # 1. test raster method + res_rast <- calculateOverlap(gpoly, gpts, verbose = FALSE, method = "raster") + expect_identical(names(res_rast@overlaps), "rna") + ovlp_rast <- overlaps(res_rast, "rna") + checkmate::expect_class(ovlp_rast, "overlapInfo") + expect_equal(nrow(ovlp_rast@data), 12383) + expect_identical(as.numeric(ovlp_rast@data[100,]), c(385, 685, 12)) + + # 2. test vector method (default) + res_vect <- calculateOverlap(gpoly, gpts, verbose = FALSE, method = "vector") + + ovlp_vect <- overlaps(res_vect, "rna") + expect_equal(nrow(ovlp_vect@data), 12311) + expect_identical(as.numeric(ovlp_vect@data[100,]), c(12, 671, 3)) + + # 3. check expected col names in output + expect_identical( + names(ovlp_vect@data), + c("poly", "feat", "feat_id_index") + ) + + # [WITH COUNTS] # counts info now automatically included if a `count` column is available # in points input # 1. test raster method - res_rast <- calculateOverlap(gpoly, gpts, verbose = FALSE, method = "raster") + res_rast <- calculateOverlap(gpoly, gpts_cts, verbose = FALSE, method = "raster") expect_identical(names(res_rast@overlaps), "rna") ovlp_rast <- overlaps(res_rast, "rna") checkmate::expect_class(ovlp_rast, "overlapInfo") @@ -49,7 +75,7 @@ test_that("calculateOverlap works for points", { expect_identical(as.numeric(ovlp_rast@data[100,]), c(385, 685, 12, 2)) # 2. test vector method (default) - res_vect <- calculateOverlap(gpoly, gpts, verbose = FALSE, method = "vector") + res_vect <- calculateOverlap(gpoly, gpts_cts, verbose = FALSE, method = "vector") ovlp_vect <- overlaps(res_vect, "rna") expect_equal(nrow(ovlp_vect@data), 12311) @@ -94,18 +120,18 @@ test_that("calculateOverlap works for affine images", { test_that("overlapToMatrix works for point overlaps", { res_vect <- calculateOverlap(gpoly, gpts, verbose = FALSE, - method = "vector", - feat_count_column = FALSE # override autodetect of "count" col + method = "vector" ) ovlp_vect <- overlaps(res_vect, "rna") expect_identical(names(ovlp_vect@data), c("poly", "feat", "feat_id_index")) # with a counts column summation - res_vect_cts <- calculateOverlap(gpoly, gpts, + res_vect_cts <- calculateOverlap(gpoly, gpts_cts, feat_count_column = "count", verbose = FALSE, method = "vector" + # count col should be autodetected ) ovlp_vect_cts <- overlaps(res_vect_cts, "rna") expect_identical(names(ovlp_vect_cts@data),