diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 00000000..f65420ac --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,204 @@ +# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples +# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help +on: + push: + branches: [dev] + pull_request: + branches: [dev] + +name: R-CMD-check.yaml + +permissions: read-all + +jobs: + R-CMD-check: + runs-on: ${{ matrix.config.os }} + + name: ${{ matrix.config.os }} (${{ matrix.config.r }}) + + strategy: + fail-fast: false + matrix: + config: + - {os: macos-latest, r: 'release'} + - {os: windows-latest, r: 'release'} + - {os: ubuntu-latest, r: 'release'} + + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + R_KEEP_PKG_SOURCE: yes + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + r-version: ${{ matrix.config.r }} + http-user-agent: ${{ matrix.config.http-user-agent }} + use-public-rspm: true + + + + - name: Install reticulate + run: | + Rscript -e "install.packages('reticulate')" + + - name: Create miniconda + run: | + Rscript -e "reticulate::install_miniconda()" + Rscript -e "reticulate::conda_install(packages = 'scipy')" + + - name: Install pak + run: | + Rscript -e "install.packages('pak')" + + - name: Install remotes + run: | + Rscript -e "install.packages('remotes')" + + - name: Install GiottoUtils + run: | + Rscript -e "remotes::install_github('drieslab/GiottoUtils@dev')" + + - name: Install GiottoData + run: | + Rscript -e "remotes::install_github('drieslab/GiottoData')" + + - name: Install rcmdcheck + run: | + Rscript -e "install.packages('rcmdcheck')" + + - name: Install knitr + run: | + Rscript -e "install.packages('knitr')" + + - name: Install rmarkdown + run: | + Rscript -e "install.packages('rmarkdown')" + + - name: Install testthat + run: | + Rscript -e "install.packages('testthat')" + + - name: Install BiocCheck + run: | + Rscript -e "install.packages('BiocManager')" + Rscript -e "BiocManager::install('BiocCheck')" + + - name: Install dbscan + run: | + Rscript -e "BiocManager::install('dbscan')" + + - name: Install deldir + run: | + Rscript -e "BiocManager::install('deldir')" + + - name: Install igraph + run: | + Rscript -e "BiocManager::install('igraph')" + + - name: Install magick + run: | + Rscript -e "BiocManager::install('magick')" + + - name: Install matrixStats + run: | + Rscript -e "BiocManager::install('matrixStats')" + + - name: Install sp + run: | + Rscript -e "BiocManager::install('sp')" + + - name: Install terra + run: | + Rscript -e "BiocManager::install('terra')" + + - name: Install scattermore + run: | + Rscript -e "install.packages('scattermore')" + + - name: Install exactextractr + run: | + Rscript -e "install.packages('exactextractr')" + + - name: Install future.apply + run: | + Rscript -e "BiocManager::install('future.apply')" + + - name: Install stars + run: | + Rscript -e "BiocManager::install('stars')" + + - name: Install qs + run: | + Rscript -e "BiocManager::install('qs')" + + - name: Install RTriangle + run: | + Rscript -e "BiocManager::install('RTriangle')" + + - name: Install geometry + run: | + Rscript -e "BiocManager::install('geometry')" + + - name: Install Seurat + run: | + Rscript -e "BiocManager::install('Seurat')" + + - name: Install chihaya + run: | + Rscript -e "BiocManager::install('chihaya')" + + - name: Install DelayedArray + run: | + Rscript -e "BiocManager::install('DelayedArray')" + + - name: Install DelayedMatrixStats + run: | + Rscript -e "BiocManager::install('DelayedMatrixStats')" + + - name: Install HDF5Array + run: | + Rscript -e "BiocManager::install('HDF5Array')" + + - name: Install rgl + run: | + Rscript -e "BiocManager::install('rgl')" + + - name: Install rhdf5 + run: | + Rscript -e "BiocManager::install('rhdf5')" + + - name: Install S4Vectors + run: | + Rscript -e "BiocManager::install('S4Vectors')" + + - name: Install ScaledMatrix + run: | + Rscript -e "BiocManager::install('ScaledMatrix')" + + - name: Install SingleCellExperiment + run: | + Rscript -e "BiocManager::install('SingleCellExperiment')" + + - name: Install SpatialExperiment + run: | + Rscript -e "BiocManager::install('SpatialExperiment')" + + - name: Install STexampleData + run: | + Rscript -e "BiocManager::install('STexampleData')" + + - name: Install SummarizedExperiment + run: | + Rscript -e "BiocManager::install('SummarizedExperiment')" + + - name: Run BiocCheck + run: | + Rscript -e "BiocCheck::BiocCheck()" + + - name: Run rcmdcheck + run: | + Rscript -e "rcmdcheck::rcmdcheck()" diff --git a/.gitignore b/.gitignore index 4524317a..d65339ec 100644 --- a/.gitignore +++ b/.gitignore @@ -8,5 +8,5 @@ inst/doc .Rprofile docs codecov.yml - +pkgdown cell_rna* diff --git a/DESCRIPTION b/DESCRIPTION index ba2f9baa..9b356edc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: GiottoClass Title: Giotto Suite object definitions and framework -Version: 0.3.5 +Version: 0.4.4 Authors@R: c( person("Ruben", "Dries", email = "rubendries@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7650-7754")), @@ -26,15 +26,13 @@ Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 Depends: - base (>= 4.0.1), - utils (>= 4.0.1), - R (>= 4.0.1), + R (>= 4.4.1) Imports: checkmate, data.table (>= 1.12.2), dbscan (>= 1.1-3), deldir (>= 1.0.6), - GiottoUtils (>= 0.1.10), + GiottoUtils (>= 0.2.0), graphics, grDevices, igraph (>= 1.2.4.1), @@ -43,9 +41,8 @@ Imports: matrixStats (>= 0.55.0), methods, reticulate (>= 1.25), - sp, stats, - terra (>= 1.7-39) + terra (>= 1.7-41) Suggests: Biobase, chihaya, @@ -57,7 +54,6 @@ Suggests: HDF5Array (>= 1.18.1), knitr, plotly, - R.utils, raster, remotes, reshape2, @@ -73,6 +69,7 @@ Suggests: SeuratObject, sf, SingleCellExperiment, + sp, SpatialExperiment, stars, STexampleData, @@ -80,7 +77,6 @@ Suggests: testthat (>= 3.0.0), qs, xml2 -Remotes: drieslab/GiottoUtils Config/testthat/edition: 3 Collate: 'package_imports.R' @@ -89,6 +85,7 @@ Collate: 'NN_network.R' 'aggregate.R' 'auxilliary.R' + 'buffer.R' 'combine_metadata.R' 'slot_accessors.R' 'create.R' @@ -107,9 +104,12 @@ Collate: 'interoperability.R' 'join.R' 'methods-IDs.R' + 'methods-XY.R' 'methods-affine.R' + 'methods-area.R' 'methods-centroids.R' 'methods-coerce.R' + 'methods-convHull.R' 'methods-copy.R' 'methods-crop.R' 'methods-dims.R' @@ -124,6 +124,7 @@ Collate: 'methods-plot.R' 'methods-rbind.R' 'methods-reconnect.R' + 'methods-relate.R' 'methods-rescale.R' 'methods-setGiotto.R' 'methods-shear.R' @@ -140,8 +141,10 @@ Collate: 'slot_check.R' 'slot_list.R' 'slot_show.R' + 'spatial_binary_ops.R' 'spatial_query.R' 'spatial_structures.R' + 'split.R' 'stitch_coordinates.R' 'subset.R' 'suite_reexports.R' diff --git a/NAMESPACE b/NAMESPACE index a96b9758..8718b174 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ S3method(.DollarNames,affine2d) S3method(.DollarNames,dimObj) +S3method(.DollarNames,giotto) S3method(.DollarNames,metaData) S3method(.DollarNames,spatEnrObj) S3method(.DollarNames,spatLocsObj) @@ -52,7 +53,6 @@ export(combineCellData) export(combineFeatureData) export(combineFeatureOverlapData) export(combineMetadata) -export(combineSpatialCellFeatureInfo) export(combineSpatialCellMetadataInfo) export(combineToMultiPolygon) export(compatible_spatial_network) @@ -125,22 +125,10 @@ export(getSpatialEnrichment) export(getSpatialGrid) export(getSpatialLocations) export(getSpatialNetwork) -export(get_NearestNetwork) export(get_adj_rescale_img) -export(get_cell_metadata) -export(get_dimReduction) export(get_distance) -export(get_expression_values) -export(get_feature_info) -export(get_feature_metadata) -export(get_giottoImage) export(get_img_minmax) export(get_multiomics) -export(get_polygon_info) -export(get_spatialGrid) -export(get_spatialNetwork) -export(get_spatial_enrichment) -export(get_spatial_locations) export(giotto) export(giottoImage) export(giottoLargeImage) @@ -235,22 +223,10 @@ export(setSpatialEnrichment) export(setSpatialGrid) export(setSpatialLocations) export(setSpatialNetwork) -export(set_NearestNetwork) -export(set_cell_metadata) export(set_default_feat_type) export(set_default_spat_unit) -export(set_dimReduction) -export(set_expression_values) -export(set_feature_info) -export(set_feature_metadata) -export(set_giottoImage) export(set_giotto_python_path) export(set_multiomics) -export(set_polygon_info) -export(set_spatialGrid) -export(set_spatialNetwork) -export(set_spatial_enrichment) -export(set_spatial_locations) export(seuratToGiotto) export(seuratToGiottoV4) export(seuratToGiottoV5) @@ -270,12 +246,14 @@ export(showGiottoSpatialInfo) export(showGrids) export(showNetworks) export(showProcessingSteps) +export(sliceGiotto) export(smoothGiottoPolygons) export(spatQueryGiottoPolygons) export(spatValues) export(spat_net_to_igraph) export(spatialExperimentToGiotto) export(spatialdataToGiotto) +export(splitGiotto) export(standardise_flex) export(stitchFieldCoordinates) export(stitchGiottoLargeImage) @@ -312,8 +290,10 @@ exportClasses(spatialGridObj) exportClasses(spatialNetworkObj) exportMethods("$") exportMethods("$<-") +exportMethods("XY<-") exportMethods("[") exportMethods("[<-") +exportMethods("[[") exportMethods("activeFeatType<-") exportMethods("activeSpatUnit<-") exportMethods("ext<-") @@ -322,10 +302,13 @@ exportMethods("instructions<-") exportMethods("objName<-") exportMethods("prov<-") exportMethods("spatUnit<-") +exportMethods(XY) exportMethods(activeFeatType) exportMethods(activeSpatUnit) exportMethods(affine) +exportMethods(area) exportMethods(as.character) +exportMethods(as.list) exportMethods(as.matrix) exportMethods(as.points) exportMethods(as.polygons) @@ -333,9 +316,11 @@ exportMethods(as.sf) exportMethods(as.sp) exportMethods(as.stars) exportMethods(as.terra) +exportMethods(buffer) exportMethods(calculateOverlap) exportMethods(centroids) exportMethods(colnames) +exportMethods(convHull) exportMethods(copy) exportMethods(createGiottoPoints) exportMethods(createGiottoPolygon) @@ -343,12 +328,17 @@ exportMethods(crop) exportMethods(density) exportMethods(dim) exportMethods(dimnames) +exportMethods(doDeferred) +exportMethods(erase) exportMethods(ext) exportMethods(featIDs) exportMethods(featType) exportMethods(flip) exportMethods(hist) exportMethods(instructions) +exportMethods(intersect) +exportMethods(minCircle) +exportMethods(minRect) exportMethods(ncol) exportMethods(nrow) exportMethods(objName) @@ -358,39 +348,35 @@ exportMethods(plot) exportMethods(prov) exportMethods(rbind2) exportMethods(reconnect) +exportMethods(relate) exportMethods(rescale) exportMethods(rownames) exportMethods(setGiotto) +exportMethods(settleGeom) exportMethods(shear) +exportMethods(snap) exportMethods(spatIDs) exportMethods(spatShift) exportMethods(spatUnit) exportMethods(spin) +exportMethods(subset) +exportMethods(symdif) exportMethods(t) +exportMethods(union) exportMethods(vect) exportMethods(wrap) exportMethods(zoom) import(GiottoUtils) import(data.table) -import(dbscan) -import(deldir) -import(magick) -import(reticulate) -import(sp) import(utils) importClassesFrom(terra,SpatExtent) importClassesFrom(terra,SpatVector) importFrom(GiottoUtils,getDistinctColors) importFrom(GiottoUtils,getMonochromeColors) importFrom(GiottoUtils,getRainbowColors) -importFrom(checkmate,assert_character) -importFrom(grDevices,dev.size) importFrom(graphics,legend) importFrom(graphics,par) importFrom(graphics,rect) -importFrom(graphics,segments) -importFrom(igraph,graph_from_data_frame) -importFrom(matrixStats,colSds) importFrom(methods,"slot<-") importFrom(methods,as) importFrom(methods,initialize) @@ -401,25 +387,35 @@ importFrom(methods,show) importFrom(methods,slot) importFrom(methods,slotNames) importFrom(methods,validObject) -importFrom(stats,cor) 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,intersect) +importMethodsFrom(terra,minCircle) +importMethodsFrom(terra,minRect) importMethodsFrom(terra,ncol) importMethodsFrom(terra,nrow) importMethodsFrom(terra,plot) +importMethodsFrom(terra,relate) importMethodsFrom(terra,rescale) +importMethodsFrom(terra,snap) importMethodsFrom(terra,spin) +importMethodsFrom(terra,symdif) importMethodsFrom(terra,t) +importMethodsFrom(terra,union) importMethodsFrom(terra,vect) importMethodsFrom(terra,wrap) importMethodsFrom(terra,zoom) diff --git a/NEWS.md b/NEWS.md index 455f9315..9bf4bc03 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,78 @@ +# GiottoClass 0.4.5 + +## enhancements + +- `spatUnit()<-` and `featType()<-` `list` methods + +# GiottoClass 0.4.4 (2024/11/14) + +## bug fixes +- fix cell metadata desyncing after `joinGiottoObjects()` +- fix `readExprMatrix()` when IDs are numerical barcodes +- fix `giottoAffineImage` not being detected during `saveGiotto()` image export step. +- fix `giottoAffineImage` `reconnect()` method + +## enhancements +- `saveGiotto()` now has `include_feat_coord` param. If `FALSE`, transcript coordinates will be dropped during saving, which will make the object much less memory intensive. +- `saveGiotto()` now has a `export_image` param. If `FALSE`, the image will not be re-exported during the save process. (They can still be reconnected) + +# GiottoClass 0.4.2 (2024/10/30) + +## bug fixes +- fix default method setting in `createNetwork()` for "delaunay" networks +- fix y spacing of `makePseudoVisium()` + +## changes +- `makePseudoVisium()` `micron_scale` (multiplicative scalefactor to get micron + scaled values) supercedes `micron_size` which used the inverse. + + +# GiottoClass 0.4.1 (2024/10/28) + +## new +- `buffer()` for `giottoPolygon`, `giottoPoints`, `spatLocsObj`. Default is to crop by voronoi borders with `settleGeom()` +- `settleGeom()` for `giottoPolygon` and `SpatVector` for finding non overlapping borders determined by voronoi + + +# GiottoClass 0.4.0 (2024/10/27) + +## breaking changes +- stop exporting deprecated internal accessors +- terra requirement raised to 1.7.41 for `minCircle()` + +## bug fixes +- fix `dimnames()` for some subobjects +- fix `joinGiottoObject()` for gobjects with only poly and point data [#233](https://github.com/drieslab/GiottoClass/issues/233) +- fix `joinGiottoObject()` for gobjects with image intensity overlaps features +- fix subsetting error due to expression `matrix` drop to `numeric` when only one cell is left +- `shift_vertical_step` and `shift_horizontal_step` args in `createGiottoPolygonsFromMask()` when numeric now shift by steps based on the dims of the image instead of just by the numerical value provided. +- fix feature metadata not being mixedsorted after join +- fix non-inclusive subsetting when not all minmax values are supplied to `subsetGiottoLocs()` +- fix `giottoAffineImage` loading after being saved + +## enhancements +- python packages to install through pip is now settable in `installGiottoEnvironment()` [#224](https://github.com/drieslab/GiottoClass/issues/224) +- `giotto` `initialize()` and slot checking behavior can be toggled now using `'giotto.init'` and `'giotto.check_valid'` options. [#946](https://github.com/drieslab/Giotto/issues/946) by rbutleriii +- `setGiotto()` now only initializes and performs checks once all items are added if a `list` input is provided. +- `instructions()` with no args will now call `createGiottoInstructions()`. You can also supply named args. +- `instructions(gobject, param)` and `instructions(gobject, param)<-` will now work for `giottoInstructions` objects for convenience. +- `[`, `[[`, `$`, `$<-`, and `subset()` for `giotto` see `?GiottoClass::subset_giotto` +- `subset` for `spatIDs()` and `featIDs()` +- `objName()`, `spatUnit()`, `featType()` generics now return `NA_character_` instead of erroring when used on unsupported classes. +- `ext()` and `ext<-()` can now be used to get and set extent of `affine2d` +- `rownames()`, `colnames()`, `dimnames()` for `giotto` +- `spatValues()` can get values from multiple spatial units. +- `createGiottoPolygonsFromMask()` now works with anything `terra::rast()` can read +- `createGiottoLargeImage()` now works with anything `terra::rast()` can read + +## new +- `sliceGiotto()` for pulling out specific spatial units and feature types as independent `giotto` objects +- `splitGiotto()` for splitting a Giotto object into a list of Giotto objects based on a cell metadata column +- `as.list()` method for `giotto` to dump the data as a list of subobjects +- `XY()` and `XY<-()` for accessing and setting coordinate values of subobjects as `matrix` +- terra `convHull()`, `minRect()`, `minCircle()` for Giotto spatial vector classes +- `area()` for `SpatVector` and `giottoPolygon` + # GiottoClass 0.3.5 (2024/08/28) diff --git a/R/NN_network.R b/R/NN_network.R index 66cc7cdc..290d2b33 100644 --- a/R/NN_network.R +++ b/R/NN_network.R @@ -128,31 +128,45 @@ NULL #' @rdname createNetwork #' @export -createNetwork <- function( - x, - type = c("sNN", "kNN", "delaunay"), - method = c("dbscan", "geometry", "RTriangle", "deldir"), - node_ids = NULL, - include_distance = TRUE, - include_weight = TRUE, - as.igraph = TRUE, - verbose = NULL, - ...) { +createNetwork <- function(x, + type = c("sNN", "kNN", "delaunay"), + method = c("dbscan", "geometry", "RTriangle", "deldir"), + node_ids = NULL, + include_distance = TRUE, + include_weight = TRUE, + as.igraph = TRUE, + verbose = NULL, + ...) { # NSE vars from <- to <- NULL # check params type <- match.arg(type, choices = c("sNN", "kNN", "delaunay")) + + mdef <- c("dbscan", "geometry", "RTriangle", "deldir") + if (type %in% c("sNN", "kNN")) { + mchoices <- c("dbscan") + if (identical(method, mdef)) method <- mchoices + } + if (type %in% c("delaunay")) { + mchoices <- c("geometry", "RTriangle", "deldir") + if (identical(method, mdef)) method <- mchoices + } + method <- switch(type, - "sNN" = match.arg(method, choices = c("dbscan"), several.ok = TRUE), - "kNN" = match.arg(method, choices = c("dbscan"), several.ok = TRUE), - "delaunay" = match.arg( - method, - choices = c("geometry", "RTriangle", "deldir"), - several.ok = TRUE - ) + "sNN" = match.arg(method, choices = mchoices, several.ok = TRUE), + "kNN" = match.arg(method, choices = mchoices, several.ok = TRUE), + "delaunay" = { + method <- method[[1L]] + match.arg(method, choices = mchoices, several.ok = TRUE) + } ) + vmsg(.is_debug = TRUE, sprintf( + "network\n type: %s\n method: %s", + type, method + )) + # get common params alist <- list( x = x, @@ -212,12 +226,11 @@ createNetwork <- function( # x input is a matrix -.net_dt_knn <- function( - x, k = 30L, include_weight = TRUE, include_distance = TRUE, - filter = FALSE, - maximum_distance = NULL, minimum_k = 0L, - weight_fun = function(d) 1 / (1 + d), - verbose = NULL, ...) { +.net_dt_knn <- function(x, k = 30L, include_weight = TRUE, include_distance = TRUE, + filter = FALSE, + maximum_distance = NULL, minimum_k = 0L, + weight_fun = function(d) 1 / (1 + d), + verbose = NULL, ...) { # NSE vars from <- to <- distance <- NULL @@ -270,11 +283,10 @@ createNetwork <- function( } # x input is a matrix -.net_dt_snn <- function( - x, k = 30L, include_weight = TRUE, include_distance = TRUE, - top_shared = 3L, minimum_shared = 5L, - weight_fun = function(d) 1 / (1 + d), - verbose = NULL, ...) { +.net_dt_snn <- function(x, k = 30L, include_weight = TRUE, include_distance = TRUE, + top_shared = 3L, minimum_shared = 5L, + weight_fun = function(d) 1 / (1 + d), + verbose = NULL, ...) { # NSE vars from <- to <- shared <- distance <- NULL @@ -321,10 +333,9 @@ createNetwork <- function( return(snn_network_dt) } -.net_dt_del_geometry <- function( - x, include_weight = TRUE, options = "Pp", maximum_distance = "auto", - minimum_k = 0L, weight_fun = function(d) 1 / d, - ...) { +.net_dt_del_geometry <- function(x, include_weight = TRUE, options = "Pp", maximum_distance = "auto", + minimum_k = 0L, weight_fun = function(d) 1 / d, + ...) { package_check("geometry", repository = "CRAN:geometry") # data.table variables @@ -335,7 +346,7 @@ createNetwork <- function( ) geometry_obj <- list("delaunay_simplex_mat" = delaunay_simplex_mat) - edge_combs <- utils::combn(x = ncol(delaunay_simplex_mat), m = 2L) + edge_combs <- combn(x = ncol(delaunay_simplex_mat), m = 2L) delaunay_edges <- data.table::as.data.table(apply( edge_combs, MARGIN = 1L, function(comb) delaunay_simplex_mat[, comb] @@ -375,10 +386,9 @@ createNetwork <- function( return(out_object) } -.net_dt_del_rtriangle <- function( - x, include_weight = TRUE, maximum_distance = "auto", minimum_k = 0L, - Y = TRUE, j = TRUE, S = 0, weight_fun = function(d) 1 / d, - ...) { +.net_dt_del_rtriangle <- function(x, include_weight = TRUE, maximum_distance = "auto", minimum_k = 0L, + Y = TRUE, j = TRUE, S = 0, weight_fun = function(d) 1 / d, + ...) { # NSE vars from <- to <- distance <- NULL @@ -420,10 +430,9 @@ createNetwork <- function( return(out_object) } -.net_dt_del_deldir <- function( - x, include_weight = TRUE, maximum_distance = "auto", minimum_k = 0L, - weight_fun = function(d) 1 / d, - ...) { +.net_dt_del_deldir <- function(x, include_weight = TRUE, maximum_distance = "auto", minimum_k = 0L, + weight_fun = function(d) 1 / d, + ...) { # NSE variables from <- to <- distance <- NULL @@ -601,34 +610,33 @@ edge_distances <- function(x, y, x_node_ids = NULL) { #' * **weight:** \eqn{1/(1 + distance)} #' * **shared:** number of shared neighbours #' * **rank:** ranking of pairwise cell neighbours -#' +#' #' For sNN networks two additional parameters can be set: #' * **minimum_shared:** minimum number of shared neighbours needed #' * **top_shared:** keep this number of the top shared neighbours, #' irrespective of minimum_shared setting -#' +#' #' @examples #' g <- GiottoData::loadGiottoMini("visium") #' #' createNearestNetwork(g) #' @export -createNearestNetwork <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - type = c("sNN", "kNN"), - dim_reduction_to_use = "pca", - dim_reduction_name = NULL, - dimensions_to_use = seq_len(10), - feats_to_use = NULL, - expression_values = c("normalized", "scaled", "custom"), - name = NULL, - return_gobject = TRUE, - k = 30, - minimum_shared = 5, - top_shared = 3, - verbose = TRUE, - ...) { +createNearestNetwork <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + type = c("sNN", "kNN"), + dim_reduction_to_use = "pca", + dim_reduction_name = NULL, + dimensions_to_use = seq_len(10), + feats_to_use = NULL, + expression_values = c("normalized", "scaled", "custom"), + name = NULL, + return_gobject = TRUE, + k = 30, + minimum_shared = 5, + top_shared = 3, + verbose = TRUE, + ...) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -809,8 +817,10 @@ createNearestNetwork <- function( nn_names <- names(gobject@nn_network[[spat_unit]][[type]]) if (name %in% nn_names) { - vmsg(.v = verbose, - name, "has already been used, will be overwritten") + vmsg( + .v = verbose, + name, "has already been used, will be overwritten" + ) } nnObj <- create_nn_net_obj( @@ -867,15 +877,16 @@ createNearestNetwork <- function( #' #' addNetworkLayout(g) #' @export -addNetworkLayout <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - layout_type = c("drl"), - options_list = NULL, - layout_name = "layout", - return_gobject = TRUE) { +addNetworkLayout <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + layout_type = c("drl"), + options_list = NULL, + layout_name = "layout", + return_gobject = TRUE) { ## checks if (is.null(nn_network_to_use) | is.null(network_name)) { stop("\n first create a nearest network \n") diff --git a/R/aggregate.R b/R/aggregate.R index e30e1ef7..b19287bf 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -149,15 +149,16 @@ NULL #' @export setMethod( "calculateOverlap", signature(x = "giotto", y = "missing"), - function(x, - name_overlap = NULL, - spatial_info = NULL, - feat_info = NULL, - image_names = NULL, - poly_subset_ids = NULL, - return_gobject = TRUE, - verbose = TRUE, - ...) { + function( + x, + name_overlap = NULL, + spatial_info = NULL, + feat_info = NULL, + image_names = NULL, + poly_subset_ids = NULL, + return_gobject = TRUE, + verbose = TRUE, + ...) { # 0. guards # # --------- # @@ -319,15 +320,16 @@ setMethod( #' @export setMethod( "calculateOverlap", signature(x = "giottoPolygon", y = "giottoPoints"), - function(x, y, - name_overlap = NULL, - poly_subset_ids = NULL, - feat_subset_column = NULL, - feat_subset_ids = NULL, - count_info_column = NULL, - return_gpolygon = TRUE, - verbose = TRUE, - ...) { + function( + x, y, + name_overlap = NULL, + poly_subset_ids = NULL, + feat_subset_column = NULL, + feat_subset_ids = NULL, + count_info_column = NULL, + return_gpolygon = TRUE, + verbose = TRUE, + ...) { res <- calculateOverlap( x = x[], y = y[], @@ -361,13 +363,12 @@ setMethod( #' @export setMethod( "calculateOverlap", signature(x = "giottoPolygon", y = "giottoLargeImage"), - function( - x, y, - name_overlap = NULL, - poly_subset_ids = NULL, - return_gpolygon = TRUE, - verbose = TRUE, - ...) { + function(x, y, + name_overlap = NULL, + poly_subset_ids = NULL, + return_gpolygon = TRUE, + verbose = TRUE, + ...) { calculateOverlap( x = x, y = y@raster_object, @@ -385,12 +386,13 @@ setMethod( #' @export setMethod( "calculateOverlap", signature(x = "giottoPolygon", y = "SpatRaster"), - function(x, y, - name_overlap = NULL, - poly_subset_ids = NULL, - return_gpolygon = TRUE, - verbose = TRUE, - ...) { + function( + x, y, + name_overlap = NULL, + poly_subset_ids = NULL, + return_gpolygon = TRUE, + verbose = TRUE, + ...) { if (is.null(name_overlap)) { .gstop("calculateOverlap: name_overlap must be given") } @@ -430,10 +432,11 @@ setMethod( #' @export setMethod( "calculateOverlap", signature(x = "SpatVector", y = "SpatRaster"), - function(x, y, - poly_subset_ids = NULL, - verbose = TRUE, - ...) { + function( + x, y, + poly_subset_ids = NULL, + verbose = TRUE, + ...) { checkmate::assert_true(terra::is.polygons(x)) GiottoUtils::package_check("exactextractr") @@ -479,12 +482,13 @@ setMethod( #' @export setMethod( "calculateOverlap", signature(x = "SpatVector", y = "SpatVector"), - function(x, y, - poly_subset_ids = NULL, - feat_subset_column = NULL, - feat_subset_ids = NULL, - count_info_column = NULL, - verbose = TRUE) { + function( + x, y, + poly_subset_ids = NULL, + feat_subset_column = NULL, + feat_subset_ids = NULL, + count_info_column = NULL, + verbose = TRUE) { checkmate::assert_true(terra::is.polygons(x)) checkmate::assert_true(terra::is.points(y)) # TODO allow another poly? if (!is.null(poly_subset_ids)) { @@ -542,17 +546,16 @@ setMethod( #' #' calculateOverlapRaster(g) #' @export -calculateOverlapRaster <- function( - gobject, - name_overlap = NULL, - spatial_info = NULL, - poly_ID_names = NULL, - feat_info = NULL, - feat_subset_column = NULL, - feat_subset_ids = NULL, - count_info_column = NULL, - return_gobject = TRUE, - verbose = TRUE) { +calculateOverlapRaster <- function(gobject, + name_overlap = NULL, + spatial_info = NULL, + poly_ID_names = NULL, + feat_info = NULL, + feat_subset_column = NULL, + feat_subset_ids = NULL, + count_info_column = NULL, + return_gobject = TRUE, + verbose = TRUE) { # set defaults if not provided if (is.null(feat_info)) { feat_info <- names(gobject@feat_info)[[1]] @@ -630,10 +633,11 @@ calculateOverlapRaster <- function( #' @returns `SpatVector` of overlapped points info #' @seealso [calculateOverlapRaster()] #' @keywords internal -.calculate_overlap_raster <- function(spatvec, - pointvec, - count_info_column = NULL, - verbose = TRUE) { +.calculate_overlap_raster <- function( + spatvec, + pointvec, + count_info_column = NULL, + verbose = TRUE) { # DT vars poly_ID <- poly_i <- ID <- x <- y <- feat_ID <- feat_ID_uniq <- NULL @@ -699,9 +703,10 @@ calculateOverlapRaster <- function( #' @description overlap for a single polygon #' @returns terra::intersect #' @keywords internal -.overlap_points_single_polygon <- function(spatvec, - poly_ID_name, - pointvec_dt) { +.overlap_points_single_polygon <- function( + spatvec, + poly_ID_name, + pointvec_dt) { # define for data.table x <- y <- NULL @@ -757,15 +762,16 @@ calculateOverlapRaster <- function( #' image_names = "dapi_z0" #' ) #' @export -calculateOverlapPolygonImages <- function(gobject, - name_overlap = "protein", - spatial_info = "cell", - poly_ID_names = NULL, - image_names = NULL, - poly_subset = NULL, - return_gobject = TRUE, - verbose = TRUE, - ...) { +calculateOverlapPolygonImages <- function( + gobject, + name_overlap = "protein", + spatial_info = "cell", + poly_ID_names = NULL, + image_names = NULL, + poly_subset = NULL, + return_gobject = TRUE, + verbose = TRUE, + ...) { # TODO consider deprecating poly_ID_names (it does nothing here.) # poly_subset is being used instead @@ -900,10 +906,11 @@ calculateOverlapPolygonImages <- function(gobject, #' @keywords internal #' @returns spatVector #' @seealso \code{\link{.overlap_points_single_polygon}} -.overlap_points_per_polygon <- function(spatvec, - pointvec, - poly_ID_names, - verbose = TRUE) { +.overlap_points_per_polygon <- function( + spatvec, + pointvec, + poly_ID_names, + verbose = TRUE) { # spatial polygon spatvec <- spatvec[terra::is.valid(spatvec)] @@ -964,14 +971,15 @@ calculateOverlapPolygonImages <- function(gobject, #' #' calculateOverlapSerial(g, spatial_info = "z1") #' @export -calculateOverlapSerial <- function(gobject, - name_overlap = NULL, - spatial_info = "cell", - feat_info = "rna", - poly_ID_names = "all", - polygon_group_size = 500, - return_gobject = TRUE, - verbose = FALSE) { +calculateOverlapSerial <- function( + gobject, + name_overlap = NULL, + spatial_info = "cell", + feat_info = "rna", + poly_ID_names = "all", + polygon_group_size = 500, + return_gobject = TRUE, + verbose = FALSE) { # spatial polygon spatvec <- gobject@spatial_info[[spatial_info]]@spatVector @@ -1036,9 +1044,10 @@ calculateOverlapSerial <- function(gobject, #' @description overlap wrapped polygons #' @returns Packed object #' @keywords internal -.overlap_points_per_polygon_wrapped <- function(spatvec_wrapped, - pointvec_wrapped, - poly_ID_names) { +.overlap_points_per_polygon_wrapped <- function( + spatvec_wrapped, + pointvec_wrapped, + poly_ID_names) { unwrap_spatvec <- terra::vect(spatvec_wrapped) unwrap_pointvec <- terra::vect(pointvec_wrapped) @@ -1086,14 +1095,15 @@ calculateOverlapSerial <- function(gobject, #' #' calculateOverlapParallel(g, spatial_info = "z1") #' @export -calculateOverlapParallel <- function(gobject, - name_overlap = NULL, - spatial_info = "cell", - feat_info = "rna", - poly_ID_names = "all", - polygon_group_size = 500, - return_gobject = TRUE, - verbose = TRUE) { +calculateOverlapParallel <- function( + gobject, + name_overlap = NULL, + spatial_info = "cell", + feat_info = "rna", + poly_ID_names = "all", + polygon_group_size = 500, + return_gobject = TRUE, + verbose = TRUE) { # spatial polygon spatvec <- gobject@spatial_info[[spatial_info]]@spatVector @@ -1205,16 +1215,17 @@ NULL #' @param verbose be verbose #' @export setMethod( - "overlapToMatrix", signature("giotto"), function(x, - name = "raw", - poly_info = NULL, - feat_info = NULL, - type = c("point", "intensity"), - count_info_column = NULL, - aggr_function = "sum", - return_gobject = TRUE, - verbose = TRUE, - ...) { + "overlapToMatrix", signature("giotto"), function( + x, + name = "raw", + poly_info = NULL, + feat_info = NULL, + type = c("point", "intensity"), + count_info_column = NULL, + aggr_function = "sum", + return_gobject = TRUE, + verbose = TRUE, + ...) { type <- match.arg(type, choices = c("point", "intensity")) checkmate::assert_character(name, len = 1L) if (!is.null(count_info_column)) { @@ -1323,12 +1334,13 @@ setMethod( #' @param output data format/class to return the results as #' @export setMethod( - "overlapToMatrix", signature("giottoPolygon"), function(x, - feat_info = "rna", - type = c("point", "intensity"), - count_info_column = NULL, - output = c("Matrix", "data.table"), - ...) { + "overlapToMatrix", signature("giottoPolygon"), function( + x, + feat_info = "rna", + type = c("point", "intensity"), + count_info_column = NULL, + output = c("Matrix", "data.table"), + ...) { type <- match.arg(type, choices = c("point", "intensity")) overlaps_data <- switch(type, @@ -1338,11 +1350,10 @@ setMethod( # ensure data exists if (is.null(overlaps_data)) { - .gstop( + stop(wrap_txt( "No overlaps found between", objName(x), "and", feat_info, " - Please run calculateOverlap() first.", - .n = 2L - ) + Please run calculateOverlap() first." + ), call. = FALSE) } argslist <- list( @@ -1375,13 +1386,14 @@ setMethod( #' no values were detected. #' @export setMethod( - "overlapToMatrix", signature("SpatVector"), function(x, - col_names = NULL, - row_names = NULL, - count_info_column = NULL, - output = c("Matrix", "data.table"), - verbose = TRUE, - ...) { + "overlapToMatrix", signature("SpatVector"), function( + x, + col_names = NULL, + row_names = NULL, + count_info_column = NULL, + output = c("Matrix", "data.table"), + verbose = TRUE, + ...) { output <- match.arg( toupper(output), choices = c("MATRIX", "DATA.TABLE") @@ -1484,9 +1496,10 @@ setMethod( #' @param aggr_function function to aggregate image information (default = sum) #' @export setMethod( - "overlapToMatrix", signature("data.table"), function(x, - aggr_function = "sum", - output = c("Matrix", "data.table")) { + "overlapToMatrix", signature("data.table"), function( + x, + aggr_function = "sum", + output = c("Matrix", "data.table")) { output <- match.arg( toupper(output), choices = c("MATRIX", "DATA.TABLE") @@ -1548,12 +1561,13 @@ setMethod( #' #' overlapToMatrixMultiPoly(g, poly_info = "z0") #' @export -overlapToMatrixMultiPoly <- function(gobject, - name = "raw", - poly_info = "cell", - feat_info = "rna", - new_poly_info = "multi", - return_gobject = TRUE) { +overlapToMatrixMultiPoly <- function( + gobject, + name = "raw", + poly_info = "cell", + feat_info = "rna", + new_poly_info = "multi", + return_gobject = TRUE) { # define for data.table i <- j <- x <- NULL @@ -1669,15 +1683,16 @@ overlapToMatrixMultiPoly <- function(gobject, #' @concept overlap #' @returns giotto object or data.table with aggregated information #' @export -overlapImagesToMatrix <- function(gobject, - name = "raw", - poly_info = "cell", - feat_info = "protein", - name_overlap = "images", - aggr_function = "sum", - image_names = NULL, - spat_locs_name = "raw", - return_gobject = TRUE) { +overlapImagesToMatrix <- function( + gobject, + name = "raw", + poly_info = "cell", + feat_info = "protein", + name_overlap = "images", + aggr_function = "sum", + image_names = NULL, + spat_locs_name = "raw", + return_gobject = TRUE) { # data.table vars value <- poly_ID <- feat_ID <- x <- y <- NULL @@ -1795,8 +1810,9 @@ overlapImagesToMatrix <- function(gobject, # volumetric understanding of the cell's expression -.combine_matrices <- function(mat_list, - summarize = "sum") { +.combine_matrices <- function( + mat_list, + summarize = "sum") { # data.table vars i <- j <- x <- i2 <- j2 <- NULL @@ -1890,13 +1906,14 @@ overlapImagesToMatrix <- function(gobject, #' #' aggregateStacksExpression(g, spat_units = c("z0", "z1"), feat_type = "rna") #' @export -aggregateStacksExpression <- function(gobject, - spat_units, - feat_type, - values = "raw", - summarize = "sum", - new_spat_unit = "aggregate", - verbose = TRUE) { +aggregateStacksExpression <- function( + gobject, + spat_units, + feat_type, + values = "raw", + summarize = "sum", + new_spat_unit = "aggregate", + verbose = TRUE) { # aggregate matrices matrix_list <- list() for (spat_unit in spat_units) { @@ -1973,8 +1990,9 @@ aggregateStacksExpression <- function(gobject, -.combine_spatlocs <- function(spatlocs_list, - summarize = "mean") { +.combine_spatlocs <- function( + spatlocs_list, + summarize = "mean") { # data.table vars sdimx <- sdimy <- sdimz <- NULL @@ -2014,11 +2032,12 @@ aggregateStacksExpression <- function(gobject, #' #' aggregateStacksLocations(g, spat_units = c("z0", "z1")) #' @export -aggregateStacksLocations <- function(gobject, - spat_units, - values = "raw", - summarize = "mean", - new_spat_unit = "aggregate") { +aggregateStacksLocations <- function( + gobject, + spat_units, + values = "raw", + summarize = "mean", + new_spat_unit = "aggregate") { # aggregate locations locs_list <- list() for (spat_unit in spat_units) { @@ -2093,10 +2112,11 @@ aggregateStacksLocations <- function(gobject, #' different z-stacks #' @returns SpatRaster #' @keywords internal -.combine_stack_spatvectors <- function(gobject, - spat_units, - for_loop = FALSE, - for_loop_group_size = 100) { +.combine_stack_spatvectors <- function( + gobject, + spat_units, + for_loop = FALSE, + for_loop_group_size = 100) { # 1. combine all spatVectors across all stacks stack_list <- list() for (spat_i in seq_len(length(spat_units))) { @@ -2176,11 +2196,12 @@ aggregateStacksLocations <- function(gobject, #' #' aggregateStacksPolygons(g, spat_units = c("z0", "z1")) #' @export -aggregateStacksPolygons <- function(gobject, - spat_units, - new_spat_unit = "aggregate", - for_loop = FALSE, - for_loop_group_size = 100) { +aggregateStacksPolygons <- function( + gobject, + spat_units, + new_spat_unit = "aggregate", + for_loop = FALSE, + for_loop_group_size = 100) { # aggregate spatvectors aggregated_spatVec <- .combine_stack_spatvectors( gobject = gobject, @@ -2225,10 +2246,11 @@ aggregateStacksPolygons <- function(gobject, #' feat_type = "rna" #' ) #' @export -aggregateStacksPolygonOverlaps <- function(gobject, - spat_units, - feat_type, - new_spat_unit = "aggregate") { +aggregateStacksPolygonOverlaps <- function( + gobject, + spat_units, + feat_type, + new_spat_unit = "aggregate") { # aggregate spatvectors polygon_list <- list() @@ -2282,16 +2304,17 @@ aggregateStacksPolygonOverlaps <- function(gobject, #' values = "raw" #' ) #' @export -aggregateStacks <- function(gobject, - spat_units, - feat_type, - values, - summarize_expression = "sum", - summarize_locations = "mean", - for_loop = FALSE, - for_loop_group_size = 100, - new_spat_unit = "aggregate", - verbose = TRUE) { +aggregateStacks <- function( + gobject, + spat_units, + feat_type, + values, + summarize_expression = "sum", + summarize_locations = "mean", + for_loop = FALSE, + for_loop_group_size = 100, + new_spat_unit = "aggregate", + verbose = TRUE) { if (isTRUE(verbose)) { wrap_msg("1. Start aggregating expression data") } diff --git a/R/auxilliary.R b/R/auxilliary.R index 653a264d..754f23e4 100644 --- a/R/auxilliary.R +++ b/R/auxilliary.R @@ -15,10 +15,11 @@ #' #' pDataDT(g) #' @export -pDataDT <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - ...) { +pDataDT <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + ...) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -67,10 +68,11 @@ pDataDT <- function(gobject, #' #' fDataDT(g) #' @export -fDataDT <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - ...) { +fDataDT <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + ...) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -111,16 +113,19 @@ fDataDT <- function(gobject, ## Feature & Cell metadata functions #### -#' @title Annotate giotto clustering +#' @title Annotate Giotto object #' @name annotateGiotto -#' @description Converts cluster results into a user provided annotation. -#' @param gobject giotto object +#' @description Map user provided annotations/labels based on another +#' existing metadata column (usually clustering labels) +#' @param gobject `giotto` object #' @param spat_unit spatial unit #' @param feat_type feature type -#' @param annotation_vector named annotation vector (names = cluster ids) -#' @param cluster_column cluster column to convert to annotation names +#' @param annotation_vector named `character` vector. Vector names are labels +#' in the cluster column. Labels to assign are the vector values. +#' @param cluster_column `character`. Cell metaadata column to map annotation +#' values based on. #' @param name new name for annotation column -#' @returns giotto object +#' @returns `giotto` object #' @details You need to specify which (cluster) column you want to annotate #' and you need to provide an annotation vector like this: #' \itemize{ @@ -149,12 +154,13 @@ fDataDT <- function(gobject, #' cluster_column = "leiden_clus" #' ) #' @export -annotateGiotto <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - annotation_vector = NULL, - cluster_column = NULL, - name = "cell_types") { +annotateGiotto <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + annotation_vector = NULL, + cluster_column = NULL, + name = "cell_types") { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -169,7 +175,7 @@ annotateGiotto <- function(gobject, # data.table: set global variable temp_cluster_name <- NULL - if (is.null(annotation_vector) | is.null(cluster_column)) { + if (is.null(annotation_vector) || is.null(cluster_column)) { stop("\n You need to provide both a named annotation vector and the corresponding cluster column \n") } @@ -193,6 +199,7 @@ annotateGiotto <- function(gobject, missing_annotations <- uniq_clusters[!uniq_clusters %in% uniq_names] no_matching_annotations <- uniq_names[!uniq_names %in% uniq_clusters] + # stop if not all clusters in cluster column got a mapped annotation value if (length(missing_annotations) > 0) { wrap_msg( "Not all clusters have an accompanying annotation in the @@ -225,11 +232,8 @@ annotateGiotto <- function(gobject, data.table::setnames(cell_metadata[], old = "temp_cluster_name", new = name) ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - gobject <- setCellMetadata( - gobject = gobject, - x = cell_metadata, - verbose = FALSE, - initialize = FALSE + gobject <- setGiotto(gobject, cell_metadata, + verbose = FALSE, initialize = FALSE ) ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### @@ -270,11 +274,12 @@ annotateGiotto <- function(gobject, #' #' g <- removeCellAnnotation(g, columns = "cell_types") #' @export -removeCellAnnotation <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - columns = NULL, - return_gobject = TRUE) { +removeCellAnnotation <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + columns = NULL, + return_gobject = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -333,11 +338,12 @@ removeCellAnnotation <- function(gobject, #' #' g <- removeFeatAnnotation(g, columns = "hvf") #' @export -removeFeatAnnotation <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - columns = NULL, - return_gobject = TRUE) { +removeFeatAnnotation <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + columns = NULL, + return_gobject = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -428,13 +434,14 @@ removeFeatAnnotation <- function(gobject, #' #' pDataDT(g) #' @export -addCellMetadata <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - new_metadata, - vector_name = NULL, - by_column = FALSE, - column_cell_ID = NULL) { +addCellMetadata <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + new_metadata, + vector_name = NULL, + by_column = FALSE, + column_cell_ID = NULL) { # NSE variables cell_ID <- NULL @@ -610,13 +617,14 @@ addCellMetadata <- function(gobject, #' #' fDataDT(g) #' @export -addFeatMetadata <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - new_metadata, - vector_name = NULL, - by_column = FALSE, - column_feat_ID = NULL) { +addFeatMetadata <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + new_metadata, + vector_name = NULL, + by_column = FALSE, + column_feat_ID = NULL) { # NSE variables feat_ID <- NULL @@ -771,11 +779,12 @@ addFeatMetadata <- function(gobject, #' #' create_average_DT(g, meta_data_name = "leiden_clus") #' @export -create_average_DT <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - meta_data_name, - expression_values = c("normalized", "scaled", "custom")) { +create_average_DT <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + meta_data_name, + expression_values = c("normalized", "scaled", "custom")) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -841,12 +850,13 @@ create_average_DT <- function(gobject, #' #' create_average_detection_DT(g, meta_data_name = "leiden_clus") #' @export -create_average_detection_DT <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - meta_data_name, - expression_values = c("normalized", "scaled", "custom"), - detection_threshold = 0) { +create_average_detection_DT <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + meta_data_name, + expression_values = c("normalized", "scaled", "custom"), + detection_threshold = 0) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -922,13 +932,14 @@ create_average_detection_DT <- function(gobject, #' #' create_cluster_matrix(g, cluster_column = "leiden_clus") #' @export -create_cluster_matrix <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - cluster_column, - feat_subset = NULL, - gene_subset = NULL) { +create_cluster_matrix <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + cluster_column, + feat_subset = NULL, + gene_subset = NULL) { # data.table variables feats <- NULL @@ -1019,13 +1030,14 @@ create_cluster_matrix <- function(gobject, #' #' calculateMetaTable(g, metadata_cols = "leiden_clus") #' @export -calculateMetaTable <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - metadata_cols = NULL, - selected_feats = NULL, - selected_genes = NULL) { +calculateMetaTable <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + metadata_cols = NULL, + selected_feats = NULL, + selected_genes = NULL) { if (is.null(metadata_cols)) stop("\n You need to select one or more valid column names from pDataDT() \n") @@ -1140,12 +1152,13 @@ calculateMetaTable <- function(gobject, #' value_cols = "leiden_clus" #' ) #' @export -calculateMetaTableCells <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - value_cols = NULL, - metadata_cols = NULL, - spat_enr_names = NULL) { +calculateMetaTableCells <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + value_cols = NULL, + metadata_cols = NULL, + spat_enr_names = NULL) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1309,8 +1322,10 @@ calculateMetaTableCells <- function(gobject, #' # These custom functions must be summary functions, as in, they must #' # produce only a single numeric output from many #' custom_stat <- function(x) { -#' if (max(x) == 0) return(0) -#' return(mean(x/max(x))) +#' if (max(x) == 0) { +#' return(0) +#' } +#' return(mean(x / max(x))) #' } #' g <- createMetafeats( #' gobject = g, @@ -1331,20 +1346,18 @@ calculateMetaTableCells <- function(gobject, #' name = "norm_scaled_mean_metafeat" #' ) #' showGiottoSpatEnrichments(g) -#' @seealso [GiottoVisuals::spatCellPlot()] #' @export -createMetafeats <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - feat_clusters, - stat = c("mean", "sum", "max", "min"), - rescale_to = NULL, - name = paste0("metafeat_", ifelse(is.function(stat), "custom", stat)), - return_gobject = TRUE, - verbose = NULL -) { - +createMetafeats <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + feat_clusters, + stat = c("mean", "sum", "max", "min"), + rescale_to = NULL, + name = paste0("metafeat_", ifelse(is.function(stat), "custom", stat)), + return_gobject = TRUE, + verbose = NULL) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, spat_unit = spat_unit @@ -1486,9 +1499,7 @@ createMetafeats <- function(gobject, # Which metafeature/cluster to assign the feature(s) to is encoded by which # numbers are named that feature. # `expr_values` should be a matrix-like -.calc_metafeat_vec <- function( - x, expr_values, stat_fun, verbose = NULL -) { +.calc_metafeat_vec <- function(x, expr_values, stat_fun, verbose = NULL) { res_list <- list() clusters <- mixedsort(unique(x)) @@ -1498,7 +1509,8 @@ createMetafeats <- function(gobject, # subset to features requested for cluster selected_feats <- names(x[x == clus_id]) sub_mat <- expr_values[ - rownames(expr_values) %in% selected_feats, , drop = FALSE + rownames(expr_values) %in% selected_feats, , + drop = FALSE ] # calculate score @@ -1517,9 +1529,7 @@ createMetafeats <- function(gobject, # cluster/metafeature and feature to assign respectively. A third `w` numeric # col can be provided which is a weight to apply to the values before # performing the stat_fun score calculation. -.calc_metafeat_dt <- function( - x, expr_values, stat_fun, verbose = NULL -) { +.calc_metafeat_dt <- function(x, expr_values, stat_fun, verbose = NULL) { # NSE vars clus <- feat <- w <- NULL @@ -1533,7 +1543,8 @@ createMetafeats <- function(gobject, # subset to features requested for cluster selected_feats <- x[clus == clus_id, feat] sub_mat <- expr_values[ - rownames(expr_values) %in% selected_feats, , drop = FALSE + rownames(expr_values) %in% selected_feats, , + drop = FALSE ] expr_feats <- rownames(sub_mat) # subset of `selected_feats` from `x` diff --git a/R/buffer.R b/R/buffer.R new file mode 100644 index 00000000..d488cb56 --- /dev/null +++ b/R/buffer.R @@ -0,0 +1,121 @@ +#' @include generics.R +NULL + +# Documentations ------------------------------------------------------------ # +#' @name buffer +#' @title Create a buffer around vector geometries +#' @description Calculate a buffer around all geometries of a `SpatVector` +#' @inheritParams terra::buffer +#' @param \dots additional params to pass +#' @param settle logical. Settle the borders between polygons by cutting them +#' where they touch based on voronoi boundaries. +#' @returns `giottoPolygon` of buffer polygons +#' @examples +#' sl <- GiottoData::loadSubObjectMini("spatLocsObj") +#' slb <- buffer(sl, 30) +#' plot(slb) +NULL + +#' @name settleGeom +#' @title Settle polygon bounds +#' @description Settle the boundaries between polygons when they overlap by +#' splitting both at the point where they touch. Works through intersection +#' with the voronoi of the centroids. +#' @param x a `SpatVector` of type "polygons" or object inheriting from +#' `giottoPolygon` +#' @returns same class as `x`, with the contained polygons borders settled +#' in relation to each other. +#' @examples +#' svp <- GiottoData::loadSubObjectMini("giottoPolygon")[] +#' svp <- buffer(svp, 5) +#' plot(svp) +#' svp <- settleGeom(svp) +#' plot(svp) +NULL +# --------------------------------------------------------------------------- # + + + + +# buffer #### +#' @rdname buffer +#' @export +setMethod("buffer", "spatLocsObj", function(x, width, ..., settle = TRUE) { + x_use <- as.points(x) + res <- buffer(x = x_use, width = width, ...) + if (settle) res <- settleGeom(res) + gpoly <- createGiottoPolygon(res, verbose = FALSE) + return(gpoly) +}) + +#' @rdname buffer +#' @export +setMethod("buffer", signature("giottoPoints"), function(x, width, ..., settle = TRUE) { + x_use <- x[] + res <- buffer(x = x_use, width = width, ...) + if (settle) res <- settleGeom(res) + res$poly_ID <- sprintf("poly_", seq_len(nrow(res))) + gpoly <- createGiottoPolygon(res, verbose = FALSE) + return(gpoly) +}) + +#' @rdname buffer +#' @export +setMethod("buffer", signature("giottoPolygon"), function(x, width, ..., settle = TRUE) { + x_use <- x[] + res <- buffer(x = x_use, width = width, ...) + if (settle) res <- settleGeom(res) + x[] <- res + return(x) +}) + + +# settleGeom #### + +#' @rdname settleGeom +#' @export +setMethod("settleGeom", signature("giottoPolygon"), function(x) { + x[] <- settleGeom(x[]) +}) + +#' @rdname settleGeom +#' @export +setMethod("settleGeom", signature("SpatVector"), function(x) { + if (!terra::geomtype(x) == "polygons") { + stop("`settleGeom()` can only be used with polygon geometries") + } + + orig_names <- names(x) + # apply index + x$.idx <- seq_len(nrow(x)) + names_keep <- c(orig_names, ".idx") + + # Find overlapping circles + overlaps <- relate(x, relation = "overlaps", pairs = TRUE) |> + as.vector() |> + unique() + if (length(overlaps) == 0L) { + return(x) + } # If no overlaps, return original polys + + # Create Voronoi polygons for the points + # Note: extend parameter ensures Voronoi polygons cover all buffer areas + vor <- terra::voronoi(centroids(x), bnd = ext(x) * 1.2) + # voronoi does not return values in order. Reorder with index + vor <- terra::sort(vor, v = ".idx") + + # Process each buffer + reslist <- lapply(overlaps, function(i) { + terra::intersect(vor[i], x[i]) + }) + + res <- do.call(rbind, reslist) + names(res)[seq_along(names_keep)] <- names_keep + res <- res[, names_keep] # drop extra fields from intersect + x <- x[-res$.idx] # drop polys to edit + x <- rbind(x, res) + x <- terra::sort(x, v = ".idx") + x <- x[, orig_names] + + return(x) +}) diff --git a/R/classes.R b/R/classes.R index 9cbe4612..6a0bb685 100644 --- a/R/classes.R +++ b/R/classes.R @@ -30,9 +30,6 @@ setClassUnion("nullOrDatatable", c("NULL", "data.table")) #' @noRd setClassUnion("gIndex", c("numeric", "logical", "character")) - - - # VIRTUAL CLASSES #### @@ -345,6 +342,8 @@ setClass("spatFeatData", ) +# OLDCLASS #### +setOldClass("giottoInstructions") @@ -460,13 +459,13 @@ updateGiottoObject <- function(gobject) { if (!methods::.hasSlot(x, "largeImages")) { return(x) } - + # transfer largeImages slot contents to images slot lgimg_list <- attr(x, "largeImages") # remove slot attr(x, "largeImages") <- NULL - + # if @largeImages was empty, expect `\001NULL\001` of class `name` # the object can be returned early now that @largeImages is stripped if (inherits(lgimg_list, "name")) { @@ -492,7 +491,7 @@ updateGiottoObject <- function(gobject) { } x@images <- c(x@images, lgimg_list) - + return(x) } @@ -505,7 +504,7 @@ updateGiottoObject <- function(gobject) { # ! Any slot modifications should also be reflected in packedGiotto class ! #' @title S4 giotto Class -#' @description \pkg{Giotto}'s core object that encapsulates all the components +#' @description Giotto's core object that encapsulates all the components #' of a spatial-omic project and facilitates analyses. #' @concept giotto object #' @slot expression expression information @@ -1661,13 +1660,16 @@ giottoLargeImage <- setClass( #' @title S4 giottoAffineImage Class #' @description #' Class extending `giottoLargeImage`. When `shear()` or `spin()` operations -#' are performed on -#' -#' +#' are performed on a `giottoLargeImage`, this class is instantiated. It +#' provides a way of storing the affine transformation and also lazily +#' performing it when required for a plotting preview. It is possible to force +#' the deferred affine transform using `doDeferred()` and return a processed +#' `giottoLargeImage`. #' @slot affine contains `affine2d` object allowing lazily performed spatial #' transforms -#' @slot funs list of functions associated with the object. Primarily to -#' perform the delayed/lazy operations +#' @slot funs list of functions associated with the object. Primarily to +#' perform the delayed/lazy operation +#' @returns `giottoAffineImage` setClass( "giottoAffineImage", contains = c("giottoLargeImage"), @@ -1727,3 +1729,18 @@ setClass( # weight = 'numeric' # ) # ) + + + + + + +# giottoSpatial #### + +setClassUnion( + name = "giottoSpatial", c("giottoPolygon", "giottoPoints", "spatLocsObj") +) + +setClassUnion( + name = "spatialClasses", c("giottoSpatial", "SpatVector") +) diff --git a/R/combine_metadata.R b/R/combine_metadata.R index 379d8320..1fe2e6be 100644 --- a/R/combine_metadata.R +++ b/R/combine_metadata.R @@ -9,7 +9,7 @@ #' @title combineMetadata #' @name combineMetadata #' @description This function combines the cell metadata with spatial locations -#' and enrichment results from \code{\link[Giotto]{runSpatialEnrich}} +#' and enrichment results from runSpatialEnrich. #' @param gobject Giotto object #' @param spat_unit spatial unit #' @param feat_type feature type @@ -22,12 +22,13 @@ #' #' combineMetadata(g) #' @export -combineMetadata <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = "raw", - spat_enr_names = NULL, - verbose = TRUE) { +combineMetadata <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = "raw", + spat_enr_names = NULL, + verbose = TRUE) { # DT vars cell_ID <- NULL @@ -89,85 +90,6 @@ combineMetadata <- function(gobject, -#' @title combineSpatialCellFeatureInfo -#' @name combineSpatialCellFeatureInfo -#' @description Combine spatial cell information (e.g. polygon) -#' and spatial feature information (e.g. transcript locations) -#' @param gobject Giotto object -#' @param spat_unit spatial unit -#' @param feat_type feature type(s) -#' @param selected_features select set of features -#' @returns list of data.table(s) -#' @details -#' The returned data.table has the following columns: \cr -#' \itemize{ -#' \item{sdimx: spatial feature location on the x-axis} -#' \item{sdimy: spatial feature location on the y-axis} -#' \item{feat_ID: unique feature ID} -#' \item{cell_ID: unique cell ID} -#' \item{used: how often was the feature used/assigned to a cell} -#' \item{feat: selected feature(s)} -#' } -#' -#' @export -combineSpatialCellFeatureInfo <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - selected_features = NULL) { - # define for data.table - feat_ID <- NULL - - # combine - # 1. spatial morphology information ( = polygon) - # 2. spatial transcript location information - - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - spatial_cell_info <- gobject@spatial_info - - if (is.null(spatial_cell_info)) { - stop("There is no available spatial segmentation/location information") - } - - - res_list <- list() - for (feat in unique(feat_type)) { - spatial_feat_locs <- gobject@feat_info[[feat]] - - if (!is.null(selected_features)) { - spatial_feat_locs <- spatial_feat_locs[ - feat_ID %in% selected_features - ] - } - - if (is.null(spatial_feat_locs)) { - stop("There is no available spatial feature location information - for ", feat, "\n") - } - - output <- .merge_spatial_locs_feat_info( - spatial_info = spatial_cell_info, - feature_info = spatial_feat_locs - ) - output[, "feat" := feat] - - res_list[[feat]] <- output - } - - return(res_list) -} - - - #' @title combineSpatialCellMetadataInfo #' @name combineSpatialCellMetadataInfo #' @description Combine cell metadata with spatial cell @@ -190,9 +112,10 @@ combineSpatialCellFeatureInfo <- function(gobject, #' #' combineSpatialCellMetadataInfo(g, spat_unit = "aggregate", feat_type = "rna") #' @export -combineSpatialCellMetadataInfo <- function(gobject, - spat_unit = NULL, - feat_type = NULL) { +combineSpatialCellMetadataInfo <- function( + gobject, + spat_unit = NULL, + feat_type = NULL) { # combine # 1. spatial morphology information ( = polygon) # 2. cell metadata @@ -262,14 +185,15 @@ combineSpatialCellMetadataInfo <- function(gobject, #' #' combineCellData(g, poly_info = "aggregate") #' @export -combineCellData <- function(gobject, - feat_type = "rna", - include_spat_locs = TRUE, - spat_loc_name = "raw", - include_poly_info = TRUE, - poly_info = "cell", - include_spat_enr = TRUE, - spat_enr_names = NULL) { +combineCellData <- function( + gobject, + feat_type = "rna", + include_spat_locs = TRUE, + spat_loc_name = "raw", + include_poly_info = TRUE, + poly_info = "cell", + include_spat_enr = TRUE, + spat_enr_names = NULL) { # combine # 1. spatial morphology information ( = polygon) # 2. cell metadata @@ -396,10 +320,11 @@ combineCellData <- function(gobject, #' #' combineFeatureData(g, spat_unit = "aggregate", feat_type = "rna") #' @export -combineFeatureData <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - sel_feats = NULL) { +combineFeatureData <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + sel_feats = NULL) { # data.table variables feat_ID <- NULL @@ -476,10 +401,11 @@ combineFeatureData <- function(gobject, #' #' combineFeatureOverlapData(g, poly_info = "aggregate") #' @export -combineFeatureOverlapData <- function(gobject, - feat_type = "rna", - sel_feats = NULL, - poly_info = "cell") { +combineFeatureOverlapData <- function( + gobject, + feat_type = "rna", + sel_feats = NULL, + poly_info = "cell") { # data.table vars feat_ID <- NULL @@ -578,13 +504,14 @@ combineFeatureOverlapData <- function(gobject, #' spat_network = "Delaunay_network", metadata_column = "leiden_clus" #' ) #' @export -calculateSpatCellMetadataProportions <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spat_network = NULL, - metadata_column = NULL, - name = "proportion", - return_gobject = TRUE) { +calculateSpatCellMetadataProportions <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + spat_network = NULL, + metadata_column = NULL, + name = "proportion", + return_gobject = TRUE) { # DT vars proptable <- target_clus <- source_clus <- network <- target <- NULL @@ -731,44 +658,6 @@ calculateSpatCellMetadataProportions <- function(gobject, # internals #### -#' @title .merge_spatial_locs_feat_info -#' @name .merge_spatial_locs_feat_info -#' @returns data.table -#' @description merge spatial cell and feature location information -#' @keywords internal -.merge_spatial_locs_feat_info <- function(spatial_info, - feature_info) { - # data.table variables - cell_ID <- used <- NULL - - reslist <- list() - for (i in seq_len(length(unique(spatial_info$cell_ID)))) { - cell_i <- unique(spatial_info$cell_ID)[i] - - temp <- sp::point.in.polygon( - point.x = feature_info$sdimx, - point.y = feature_info$sdimy, - pol.x = spatial_info[cell_ID == cell_i]$sdimx, - pol.y = spatial_info[cell_ID == cell_i]$sdimy - ) - - detected_feats <- feature_info[temp == 1] - detected_feats[, cell_ID := cell_i] - - reslist[[i]] <- detected_feats - } - - reslistfinal <- do.call("rbind", reslist) - - # calculate how often a single transcript is used - # > 1 means that a transcript was assigned to more than 1 cell - reslistfinal[, used := .N, by = c("sdimx", "sdimy", "feat_ID")] - - return(reslistfinal) -} - - - #' @title .merge_spatial_enrich_info @@ -778,11 +667,12 @@ calculateSpatCellMetadataProportions <- function(gobject, #' @keywords internal #' @returns data.table # spat_unit and feat_type are expected to not be NULL. -.merge_spatial_enrich_info <- function(gobject, - comb_dt, - spat_unit, - feat_type, - spat_enr_names = NULL) { +.merge_spatial_enrich_info <- function( + gobject, + comb_dt, + spat_unit, + feat_type, + spat_enr_names = NULL) { if (is.null(spat_enr_names)) { return(comb_dt) } # skip if not requested diff --git a/R/create.R b/R/create.R index f82ac3fd..13739edb 100644 --- a/R/create.R +++ b/R/create.R @@ -100,30 +100,31 @@ NULL #' #' createGiottoObject(expression = expr_matrix) #' @export -createGiottoObject <- function(expression, - expression_feat = "rna", - spatial_locs = NULL, - spatial_info = NULL, - calc_poly_centroids = FALSE, - centroids_to_spatlocs = FALSE, - feat_info = NULL, - cell_metadata = NULL, - feat_metadata = NULL, - spatial_network = NULL, - spatial_grid = NULL, - spatial_grid_name = NULL, - spatial_enrichment = NULL, - dimension_reduction = NULL, - nn_network = NULL, - images = NULL, - largeImages = NULL, - offset_file = NULL, - instructions = NULL, - cores = determine_cores(), - raw_exprs = NULL, - expression_matrix_class = c("dgCMatrix", "DelayedArray"), - h5_file = NULL, - verbose = FALSE) { +createGiottoObject <- function( + expression, + expression_feat = "rna", + spatial_locs = NULL, + spatial_info = NULL, + calc_poly_centroids = FALSE, + centroids_to_spatlocs = FALSE, + feat_info = NULL, + cell_metadata = NULL, + feat_metadata = NULL, + spatial_network = NULL, + spatial_grid = NULL, + spatial_grid_name = NULL, + spatial_enrichment = NULL, + dimension_reduction = NULL, + nn_network = NULL, + images = NULL, + largeImages = NULL, + offset_file = NULL, + instructions = NULL, + cores = determine_cores(), + raw_exprs = NULL, + expression_matrix_class = c("dgCMatrix", "DelayedArray"), + h5_file = NULL, + verbose = FALSE) { debug_msg <- FALSE # for reading debug help initialize_per_step <- FALSE @@ -159,11 +160,11 @@ createGiottoObject <- function(expression, # "scran", "MAST", "png", "tiff", "biomaRt", # "trendsceek", "multinet", "RTriangle", "FactoMineR" # ) - # - # pack_index <- extra_packages %in% rownames(utils::installed.packages()) + # + # pack_index <- extra_packages %in% rownames(installed.packages()) # extra_installed_packages <- extra_packages[pack_index] # extra_not_installed_packages <- extra_packages[!pack_index] - # + # # if (any(pack_index == FALSE) == TRUE) { # wrap_msg( # "Consider to install these (optional) packages to run all possible", @@ -351,7 +352,8 @@ createGiottoObject <- function(expression, dummySpatLocObj <- createSpatLocsObj( name = "raw", coordinates = spatial_locs, - spat_unit = spat_unit + spat_unit = spat_unit, + provenance = spat_unit ) ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### @@ -654,27 +656,26 @@ createGiottoObject <- function(expression, #' gpoints = x_gpoints #' ) #' @export -createGiottoObjectSubcellular <- function( - gpolygons = NULL, - polygon_mask_list_params = NULL, - polygon_dfr_list_params = NULL, - gpoints = NULL, - cell_metadata = NULL, - feat_metadata = NULL, - spatial_network = NULL, - spatial_network_name = NULL, - spatial_grid = NULL, - spatial_grid_name = NULL, - spatial_enrichment = NULL, - spatial_enrichment_name = NULL, - dimension_reduction = NULL, - nn_network = NULL, - images = NULL, - largeImages = NULL, - largeImages_list_params = NULL, - instructions = NULL, - cores = NA, - verbose = FALSE) { +createGiottoObjectSubcellular <- function(gpolygons = NULL, + polygon_mask_list_params = NULL, + polygon_dfr_list_params = NULL, + gpoints = NULL, + cell_metadata = NULL, + feat_metadata = NULL, + spatial_network = NULL, + spatial_network_name = NULL, + spatial_grid = NULL, + spatial_grid_name = NULL, + spatial_enrichment = NULL, + spatial_enrichment_name = NULL, + dimension_reduction = NULL, + nn_network = NULL, + images = NULL, + largeImages = NULL, + largeImages_list_params = NULL, + instructions = NULL, + cores = NA, + verbose = FALSE) { # data.table vars poly_ID <- cell_ID <- feat_ID <- x <- y <- NULL @@ -817,11 +818,14 @@ createGiottoObjectSubcellular <- function( # generate named list of giottoPoints objects points_res <- .extract_points_list(pointslist = gpoints) gobject <- setGiotto( - gobject, points_res, verbose = FALSE, initialize = FALSE + gobject, points_res, + verbose = FALSE, initialize = FALSE ) - vmsg(.v = verbose, - "4. Finished extracting spatial feature information") + vmsg( + .v = verbose, + "4. Finished extracting spatial feature information" + ) ## expression features ## ## ------------------- ## @@ -953,9 +957,11 @@ createGiottoObjectSubcellular <- function( name = networkname, network = network, spat_unit = names( - slot(gobject, "spatial_info"))[[1]], + slot(gobject, "spatial_info") + )[[1]], provenance = names( - slot(gobject, "spatial_info"))[[1]] + slot(gobject, "spatial_info") + )[[1]] ) # assumed ### ### ### ### ### ### ### ### ### ### ### ### ### ### @@ -1000,7 +1006,8 @@ createGiottoObjectSubcellular <- function( if (inherits(grid, c("data.table", "data.frame"))) { if (all(c( - "x_start", "y_start", "x_end", "y_end", "gr_name") %in% + "x_start", "y_start", "x_end", "y_end", "gr_name" + ) %in% colnames(grid))) { if (!inherits(grid, "data.table")) { grid <- data.table::setDT(grid) @@ -1085,7 +1092,8 @@ createGiottoObjectSubcellular <- function( dim_red <- dimension_reduction[[dim_i]] if (all(c( - "type", "name", "reduction_method", "coordinates", "misc") %in% + "type", "name", "reduction_method", "coordinates", "misc" + ) %in% names(dim_red))) { coord_data <- dim_red[["coordinates"]] @@ -1163,7 +1171,7 @@ createGiottoObjectSubcellular <- function( default_base <- "image" images <- lapply(seq_along(images), function(img_i) { im <- images[[img_i]] - + # already in giotto format if (inherits(im, c("giottoImage", "giottoLargeImage"))) { return(im) @@ -1244,13 +1252,14 @@ createGiottoObjectSubcellular <- function( #' #' createExprObj(expression_data = x_expr) #' @export -createExprObj <- function(expression_data, - name = "test", - spat_unit = "cell", - feat_type = "rna", - provenance = NULL, - misc = NULL, - expression_matrix_class = c("dgCMatrix", "DelayedArray")) { +createExprObj <- function( + expression_data, + name = "test", + spat_unit = "cell", + feat_type = "rna", + provenance = NULL, + misc = NULL, + expression_matrix_class = c("dgCMatrix", "DelayedArray", "dbSparseMatrix")) { exprMat <- .evaluate_expr_matrix(expression_data, expression_matrix_class = expression_matrix_class, feat_type = feat_type @@ -1280,15 +1289,16 @@ createExprObj <- function(expression_data, #' create_expr_obj(exprMat = x_expr) #' #' @export -create_expr_obj <- function(name = "test", - exprMat = NULL, - spat_unit = "cell", - feat_type = "rna", - provenance = NULL, - misc = NULL) { +create_expr_obj <- function( + name = "test", + exprMat = NULL, + spat_unit = "cell", + feat_type = "rna", + provenance = NULL, + misc = NULL) { deprecate_soft("3.3.0", - what = "Giotto::create_expr_obj()", - with = "Giotto::createExprObj()" + what = "create_expr_obj()", + with = "createExprObj()" ) if (is.null(exprMat)) exprMat <- matrix() @@ -1325,12 +1335,13 @@ create_expr_obj <- function(name = "test", #' #' createCellMetaObj(metadata = df) #' @export -createCellMetaObj <- function(metadata, - spat_unit = "cell", - feat_type = "rna", - provenance = NULL, - col_desc = NULL, - verbose = TRUE) { +createCellMetaObj <- function( + metadata, + spat_unit = "cell", + feat_type = "rna", + provenance = NULL, + col_desc = NULL, + verbose = TRUE) { metadata <- .evaluate_cell_metadata( metadata = metadata, verbose = verbose @@ -1352,14 +1363,15 @@ createCellMetaObj <- function(metadata, #' @returns cell_meta_obj #' #' @export -create_cell_meta_obj <- function(metaDT = NULL, - col_desc = NA_character_, - spat_unit = "cell", - feat_type = "rna", - provenance = NULL) { +create_cell_meta_obj <- function( + metaDT = NULL, + col_desc = NA_character_, + spat_unit = "cell", + feat_type = "rna", + provenance = NULL) { deprecate_soft("3.3.0", - what = "Giotto::create_cell_meta_obj()", - with = "Giotto::createCellMetaObj()" + what = "create_cell_meta_obj()", + with = "createCellMetaObj()" ) if (is.null(col_desc)) col_desc <- NA_character_ @@ -1404,12 +1416,13 @@ create_cell_meta_obj <- function(metaDT = NULL, #' #' createFeatMetaObj(metadata = x) #' @export -createFeatMetaObj <- function(metadata, - spat_unit = "cell", - feat_type = "rna", - provenance = NULL, - col_desc = NULL, - verbose = TRUE) { +createFeatMetaObj <- function( + metadata, + spat_unit = "cell", + feat_type = "rna", + provenance = NULL, + col_desc = NULL, + verbose = TRUE) { metadata <- .evaluate_feat_metadata( metadata = metadata, verbose = verbose @@ -1430,14 +1443,15 @@ createFeatMetaObj <- function(metadata, #' @keywords internal #' @returns feat_meta_obj #' @export -create_feat_meta_obj <- function(metaDT = NULL, - col_desc = NA_character_, - spat_unit = "cell", - feat_type = "rna", - provenance = NULL) { +create_feat_meta_obj <- function( + metaDT = NULL, + col_desc = NA_character_, + spat_unit = "cell", + feat_type = "rna", + provenance = NULL) { deprecate_soft("3.3.0", - what = "Giotto::create_feat_meta_obj()", - with = "Giotto::createFeatMetaObj()" + what = "create_feat_meta_obj()", + with = "createFeatMetaObj()" ) if (is.null(col_desc)) col_desc <- NA_character_ @@ -1485,15 +1499,16 @@ create_feat_meta_obj <- function(metaDT = NULL, #' #' createDimObj(coordinates = x, name = "pca", method = "pca") #' @export -createDimObj <- function(coordinates, - name = "test", - spat_unit = "cell", - feat_type = "rna", - method = NULL, - reduction = "cells", - provenance = NULL, - misc = NULL, - my_rownames = NULL) { +createDimObj <- function( + coordinates, + name = "test", + spat_unit = "cell", + feat_type = "rna", + method = NULL, + reduction = "cells", + provenance = NULL, + misc = NULL, + my_rownames = NULL) { coordinates <- .evaluate_dimension_reduction(coordinates) create_dim_obj( @@ -1515,18 +1530,19 @@ createDimObj <- function(coordinates, #' @keywords internal #' @returns dim_obj #' @export -create_dim_obj <- function(name = "test", - reduction = "cells", - reduction_method = NA_character_, - coordinates = NULL, - spat_unit = "cell", - feat_type = "rna", - provenance = NULL, - misc = NULL, - my_rownames = NULL) { +create_dim_obj <- function( + name = "test", + reduction = "cells", + reduction_method = NA_character_, + coordinates = NULL, + spat_unit = "cell", + feat_type = "rna", + provenance = NULL, + misc = NULL, + my_rownames = NULL) { deprecate_soft("3.3.0", - what = "Giotto::create_dim_obj()", - with = "Giotto::createDimObj()" + what = "create_dim_obj()", + with = "createDimObj()" ) if (is.null(reduction_method)) reduction_method <- NA_character_ @@ -1581,13 +1597,14 @@ create_dim_obj <- function(name = "test", #' nn_type = "sNN" #' ) #' @export -createNearestNetObj <- function(name = "test", - network, - nn_type = NULL, - spat_unit = "cell", - feat_type = "rna", - provenance = NULL, - misc = NULL) { +createNearestNetObj <- function( + name = "test", + network, + nn_type = NULL, + spat_unit = "cell", + feat_type = "rna", + provenance = NULL, + misc = NULL) { if (is.null(network)) { igraph <- NULL } else { @@ -1612,16 +1629,17 @@ createNearestNetObj <- function(name = "test", #' @keywords internal #' @returns nn_net_obj #' @export -create_nn_net_obj <- function(name = "test", - nn_type = NA_character_, - igraph = NULL, - spat_unit = "cell", - feat_type = "rna", - provenance = NULL, - misc = NULL) { +create_nn_net_obj <- function( + name = "test", + nn_type = NA_character_, + igraph = NULL, + spat_unit = "cell", + feat_type = "rna", + provenance = NULL, + misc = NULL) { deprecate_soft("3.3.0", - what = "Giotto::create_nn_net_obj()", - with = "Giotto::createNearestNetObj()" + what = "create_nn_net_obj()", + with = "createNearestNetObj()" ) if (is.null(nn_type)) nn_type <- NA_character_ @@ -1664,12 +1682,13 @@ create_nn_net_obj <- function(name = "test", #' #' createSpatLocsObj(coordinates = x, name = "raw") #' @export -createSpatLocsObj <- function(coordinates, - name = "test", - spat_unit = "cell", - provenance = NULL, - misc = NULL, - verbose = TRUE) { +createSpatLocsObj <- function( + coordinates, + name = "test", + spat_unit = "cell", + provenance = NULL, + misc = NULL, + verbose = TRUE) { # convert coordinates input to preferred format coordinates <- .evaluate_spatial_locations( spatial_locs = coordinates, @@ -1691,14 +1710,15 @@ createSpatLocsObj <- function(coordinates, #' @keywords internal #' @returns spat_locs_obj #' @export -create_spat_locs_obj <- function(name = "test", - coordinates = NULL, - spat_unit = "cell", - provenance = NULL, - misc = NULL) { +create_spat_locs_obj <- function( + name = "test", + coordinates = NULL, + spat_unit = "cell", + provenance = NULL, + misc = NULL) { deprecate_soft("3.3.0", - what = "Giotto::create_spat_locs_obj()", - with = "Giotto::createSpatLocsObj()" + what = "create_spat_locs_obj()", + with = "createSpatLocsObj()" ) # DT vars @@ -1758,17 +1778,18 @@ create_spat_locs_obj <- function(name = "test", #' #' createSpatNetObj(network = slot(x, "networkDT"), name = "Delaunay_network") #' @export -createSpatNetObj <- function(network, - name = "test", - networkDT_before_filter = NULL, - method = NULL, - spat_unit = "cell", - provenance = NULL, - parameters = NULL, - outputObj = NULL, - cellShapeObj = NULL, - crossSectionObjects = NULL, - misc = NULL) { +createSpatNetObj <- function( + network, + name = "test", + networkDT_before_filter = NULL, + method = NULL, + spat_unit = "cell", + provenance = NULL, + parameters = NULL, + outputObj = NULL, + cellShapeObj = NULL, + crossSectionObjects = NULL, + misc = NULL) { networkDT <- .evaluate_spatial_network(network) create_spat_net_obj( @@ -1792,20 +1813,21 @@ createSpatNetObj <- function(network, #' @keywords internal #' @returns spat_net_obj #' @export -create_spat_net_obj <- function(name = "test", - method = NA_character_, - parameters = NULL, - outputObj = NULL, - networkDT = NULL, - networkDT_before_filter = NULL, - cellShapeObj = NULL, - crossSectionObjects = NULL, - spat_unit = "cell", - provenance = NULL, - misc = NULL) { +create_spat_net_obj <- function( + name = "test", + method = NA_character_, + parameters = NULL, + outputObj = NULL, + networkDT = NULL, + networkDT_before_filter = NULL, + cellShapeObj = NULL, + crossSectionObjects = NULL, + spat_unit = "cell", + provenance = NULL, + misc = NULL) { deprecate_soft("3.3.0", - what = "Giotto::create_spat_net_obj()", - with = "Giotto::createSpatNetObj()" + what = "create_spat_net_obj()", + with = "createSpatNetObj()" ) if (is.null(method)) method <- NA_character_ @@ -1853,14 +1875,15 @@ create_spat_net_obj <- function(name = "test", #' name = "cluster_metagene" #' ) #' @export -createSpatEnrObj <- function(enrichment_data, - name = "test", - spat_unit = "cell", - feat_type = "rna", - method = NULL, - provenance = NULL, - misc = NULL, - verbose = TRUE) { +createSpatEnrObj <- function( + enrichment_data, + name = "test", + spat_unit = "cell", + feat_type = "rna", + method = NULL, + provenance = NULL, + misc = NULL, + verbose = TRUE) { enrichDT <- .evaluate_spatial_enrichment(enrichment_data, verbose = verbose) create_spat_enr_obj( @@ -1880,16 +1903,17 @@ createSpatEnrObj <- function(enrichment_data, #' @keywords internal #' @returns spat_enr_obj #' @export -create_spat_enr_obj <- function(name = "test", - method = NA_character_, - enrichDT = NULL, - spat_unit = "cell", - feat_type = "rna", - provenance = NULL, - misc = NULL) { +create_spat_enr_obj <- function( + name = "test", + method = NA_character_, + enrichDT = NULL, + spat_unit = "cell", + feat_type = "rna", + provenance = NULL, + misc = NULL) { deprecate_soft("3.3.0", - what = "Giotto::create_spat_enr_obj()", - with = "Giotto::createSpatEnrObj()" + what = "create_spat_enr_obj()", + with = "createSpatEnrObj()" ) if (is.null(method)) method <- NA_character_ @@ -1935,14 +1959,15 @@ create_spat_enr_obj <- function(name = "test", #' #' create_spat_grid_obj(name = "test", gridDT = x) #' @export -create_spat_grid_obj <- function(name = "test", - method = NA_character_, - parameters = NULL, - gridDT = NULL, - spat_unit = "cell", - feat_type = "rna", - provenance = NULL, - misc = NULL) { +create_spat_grid_obj <- function( + name = "test", + method = NA_character_, + parameters = NULL, + gridDT = NULL, + spat_unit = "cell", + feat_type = "rna", + provenance = NULL, + misc = NULL) { return(new("spatialGridObj", name = name, method = method, @@ -1969,10 +1994,11 @@ create_spat_grid_obj <- function(name = "test", #' @param full fully connected status #' @keywords internal #' @returns featureNetwork_object -create_featureNetwork_object <- function(name = "feat_network", - network_datatable = NULL, - network_lookup_id = NULL, - full = NULL) { +create_featureNetwork_object <- function( + name = "feat_network", + network_datatable = NULL, + network_lookup_id = NULL, + full = NULL) { # create minimum giotto points object f_network <- featureNetwork( name = name, @@ -2063,11 +2089,12 @@ NULL #' @export setMethod( "createGiottoPoints", signature("SpatVector"), - function(x, - feat_type = "rna", - verbose = TRUE, - split_keyword = NULL, - unique_IDs = NULL) { + function( + x, + feat_type = "rna", + verbose = TRUE, + split_keyword = NULL, + unique_IDs = NULL) { checkmate::assert_character(feat_type) if (!is.null(split_keyword)) checkmate::assert_list(split_keyword) @@ -2118,14 +2145,15 @@ setMethod( #' @export setMethod( "createGiottoPoints", signature("data.frame"), - function(x, - x_colname = NULL, - y_colname = NULL, - feat_ID_colname = NULL, - feat_type = "rna", - verbose = TRUE, - split_keyword = NULL, - unique_IDs = NULL) { + function( + x, + x_colname = NULL, + y_colname = NULL, + feat_ID_colname = NULL, + feat_type = "rna", + verbose = TRUE, + split_keyword = NULL, + unique_IDs = NULL) { checkmate::assert_character(feat_type) if (!is.null(split_keyword)) checkmate::assert_list(split_keyword) @@ -2159,10 +2187,11 @@ setMethod( #' @param unique_IDs (optional) unique IDs in spatVector for cacheing #' @keywords internal #' @returns giotto_points_object -create_giotto_points_object <- function(feat_type = "rna", - spatVector = NULL, - networks = NULL, - unique_IDs = NULL) { +create_giotto_points_object <- function( + feat_type = "rna", + spatVector = NULL, + networks = NULL, + unique_IDs = NULL) { if (is.null(feat_type)) feat_type <- NA # compliance with featData class # create minimum giotto points object @@ -2313,21 +2342,22 @@ setMethod( #' @export setMethod( "createGiottoPolygon", signature("SpatRaster"), - function(x, - name = "cell", - mask_method = c("guess", "single", "multiple"), - remove_background_polygon = FALSE, - background_algo = c("range"), - fill_holes = TRUE, - poly_IDs = NULL, - ID_fmt = "cell_", - flip_vertical = TRUE, - shift_vertical_step = TRUE, - flip_horizontal = TRUE, - shift_horizontal_step = TRUE, - remove_unvalid_polygons = TRUE, - calc_centroids = FALSE, - verbose = TRUE) { + function( + x, + name = "cell", + mask_method = c("guess", "single", "multiple"), + remove_background_polygon = FALSE, + background_algo = c("range"), + fill_holes = TRUE, + poly_IDs = NULL, + ID_fmt = "cell_", + flip_vertical = TRUE, + shift_vertical_step = TRUE, + flip_horizontal = TRUE, + shift_horizontal_step = TRUE, + remove_unvalid_polygons = TRUE, + calc_centroids = FALSE, + verbose = TRUE) { # verbose not used createGiottoPolygonsFromMask( @@ -2368,12 +2398,13 @@ setMethod( #' @export setMethod( "createGiottoPolygon", signature("data.frame"), - function(x, - name = "cell", - calc_centroids = FALSE, - skip_eval_dfr = FALSE, - copy_dt = TRUE, - verbose = TRUE) { + function( + x, + name = "cell", + calc_centroids = FALSE, + skip_eval_dfr = FALSE, + copy_dt = TRUE, + verbose = TRUE) { createGiottoPolygonsFromDfr( segmdfr = x, name = name, @@ -2387,7 +2418,8 @@ setMethod( #' @rdname createGiottoPolygon -#' @param maskfile path to mask file +#' @param maskfile path to mask file, a terra `SpatRaster`, or some other +#' data class readable by [terra::rast()] #' @param mask_method how the mask file defines individual segmentation #' annotations. See *mask_method* section #' @param name character. Name to assign created `giottoPolygon` @@ -2456,22 +2488,21 @@ setMethod( #' ) #' plot(gpoly2, col = grDevices::hcl.colors(5)) #' @export -createGiottoPolygonsFromMask <- function( - maskfile, - mask_method = c("guess", "single", "multiple"), - name = "cell", - remove_background_polygon = FALSE, - background_algo = c("range"), - fill_holes = TRUE, - poly_IDs = NULL, - ID_fmt = "cell_", - flip_vertical = TRUE, - shift_vertical_step = TRUE, - flip_horizontal = TRUE, - shift_horizontal_step = TRUE, - calc_centroids = FALSE, - remove_unvalid_polygons = TRUE, - verbose = FALSE) { +createGiottoPolygonsFromMask <- function(maskfile, + mask_method = c("guess", "single", "multiple"), + name = "cell", + remove_background_polygon = FALSE, + background_algo = c("range"), + fill_holes = TRUE, + poly_IDs = NULL, + ID_fmt = "cell_", + flip_vertical = TRUE, + shift_vertical_step = TRUE, + flip_horizontal = TRUE, + shift_horizontal_step = TRUE, + calc_centroids = FALSE, + remove_unvalid_polygons = TRUE, + verbose = FALSE) { # data.table vars x <- y <- geom <- part <- NULL @@ -2491,15 +2522,16 @@ createGiottoPolygonsFromMask <- function( # if maskfile input is not a spatraster, read it in as spatraster # if it is spatraster, skip - if (!inherits(maskfile, "SpatRaster")) { + if (inherits(maskfile, "SpatRaster")) { + terra_rast <- maskfile + } else if (is.character(maskfile)) { # check if mask file exists maskfile <- path.expand(maskfile) - if (!file.exists(maskfile)) { - stop("path : ", maskfile, " does not exist \n") - } + checkmate::assert_file_exists(maskfile) terra_rast <- .create_terra_spatraster(maskfile) } else { - terra_rast <- maskfile + # assume some other class readable by terra::rast() + terra_rast <- .create_terra_spatraster(maskfile) } # create polygons from mask @@ -2597,14 +2629,14 @@ createGiottoPolygonsFromMask <- function( if (identical(shift_vertical_step, TRUE)) { shift_vertical_step <- rast_dimensions[1] # nrows of raster } else if (is.numeric(shift_vertical_step)) { - shift_vertical_step <- shift_vertical_step + shift_vertical_step <- rast_dimensions[1] * shift_vertical_step } else { shift_vertical_step <- 0 } if (identical(shift_horizontal_step, TRUE)) { shift_horizontal_step <- rast_dimensions[2] # ncols of raster } else if (is.numeric(shift_horizontal_step)) { - shift_horizontal_step <- shift_horizontal_step + shift_horizontal_step <- rast_dimensions[2] * shift_horizontal_step } else { shift_horizontal_step <- 0 } @@ -2704,12 +2736,13 @@ createGiottoPolygonsFromMask <- function( #' default to the 1st and 2nd columns. #' @concept polygon #' @export -createGiottoPolygonsFromDfr <- function(segmdfr, - name = "cell", - calc_centroids = FALSE, - verbose = TRUE, - skip_eval_dfr = FALSE, - copy_dt = TRUE) { +createGiottoPolygonsFromDfr <- function( + segmdfr, + name = "cell", + calc_centroids = FALSE, + verbose = TRUE, + skip_eval_dfr = FALSE, + copy_dt = TRUE) { eval_list <- .evaluate_spatial_info( spatial_info = segmdfr, skip_eval_dfr = skip_eval_dfr, @@ -2753,10 +2786,11 @@ createGiottoPolygonsFromDfr <- function(segmdfr, #' @param verbose be verbose #' @concept polygon #' @export -createGiottoPolygonsFromGeoJSON <- function(GeoJSON, - name = "cell", - calc_centroids = FALSE, - verbose = TRUE) { +createGiottoPolygonsFromGeoJSON <- function( + GeoJSON, + name = "cell", + calc_centroids = FALSE, + verbose = TRUE) { eval_list <- .evaluate_spatial_info( spatial_info = GeoJSON, verbose = verbose @@ -2800,11 +2834,12 @@ createGiottoPolygonsFromGeoJSON <- function(GeoJSON, #' @param unique_IDs unique polygon IDs for cacheing #' @keywords internal #' @returns giotto_polygon_object -create_giotto_polygon_object <- function(name = "cell", - spatVector = NULL, - spatVectorCentroids = NULL, - overlaps = NULL, - unique_IDs = NULL) { +create_giotto_polygon_object <- function( + name = "cell", + spatVector = NULL, + spatVectorCentroids = NULL, + overlaps = NULL, + unique_IDs = NULL) { # create minimum giotto g_polygon <- giottoPolygon( name = name, @@ -2904,30 +2939,31 @@ create_giotto_polygon_object <- function(name = "cell", #' #' createGiottoImage(mg_object = image_test) #' @export -createGiottoImage <- function(gobject = NULL, - spat_unit = NULL, - spatial_locs = NULL, - spat_loc_name = NULL, - mg_object, - name = "image", - image_transformations = NULL, - negative_y = TRUE, - do_manual_adj = FALSE, - xmax_adj = 0, - xmin_adj = 0, - ymax_adj = 0, - ymin_adj = 0, - scale_factor = 1, - x_shift = NULL, - y_shift = NULL, - scale_x = NULL, - scale_y = NULL, - order = c("first_scale", "first_adj"), - xmin_set = NULL, - xmax_set = NULL, - ymin_set = NULL, - ymax_set = NULL, - verbose = TRUE) { +createGiottoImage <- function( + gobject = NULL, + spat_unit = NULL, + spatial_locs = NULL, + spat_loc_name = NULL, + mg_object, + name = "image", + image_transformations = NULL, + negative_y = TRUE, + do_manual_adj = FALSE, + xmax_adj = 0, + xmin_adj = 0, + ymax_adj = 0, + ymin_adj = 0, + scale_factor = 1, + x_shift = NULL, + y_shift = NULL, + scale_x = NULL, + scale_y = NULL, + order = c("first_scale", "first_adj"), + xmin_set = NULL, + xmax_set = NULL, + ymin_set = NULL, + ymax_set = NULL, + verbose = TRUE) { # Check params order <- match.arg(order, choices = c("first_scale", "first_adj")) scale_factor <- c(x = scale_factor, y = scale_factor) @@ -3140,7 +3176,8 @@ createGiottoImage <- function(gobject = NULL, #' @name createGiottoLargeImage #' @description Creates a large giotto image that can be added to a Giotto #' subcellular object. Generates deep copy of SpatRaster -#' @param raster_object terra SpatRaster image object +#' @param raster_object filepath to an image, a terra `SpatRaster` or, other format +#' openable via [terra::rast()] #' @param name name for the image #' @param negative_y Map image to negative y spatial values if TRUE. Meaning #' that origin is in upper left instead of lower left. @@ -3164,59 +3201,43 @@ createGiottoImage <- function(gobject = NULL, #' #' createGiottoLargeImage(raster_object = image_test) #' @export -createGiottoLargeImage <- function(raster_object, - name = "image", - negative_y = TRUE, - extent = NULL, - use_rast_ext = FALSE, - image_transformations = NULL, - flip_vertical = FALSE, - flip_horizontal = FALSE, - xmax_bound = NULL, - xmin_bound = NULL, - ymax_bound = NULL, - ymin_bound = NULL, - scale_factor = 1, - verbose = TRUE) { +createGiottoLargeImage <- function( + raster_object, + name = "image", + negative_y = TRUE, + extent = NULL, + use_rast_ext = FALSE, + image_transformations = NULL, + flip_vertical = FALSE, + flip_horizontal = FALSE, + xmax_bound = NULL, + xmin_bound = NULL, + ymax_bound = NULL, + ymin_bound = NULL, + scale_factor = 1, + verbose = TRUE) { # create minimum giotto g_imageL <- new("giottoLargeImage", name = name) - ## 1. check raster object and load as SpatRaster if necessary - if (!inherits(raster_object, "SpatRaster")) { - if (file.exists(raster_object)) { - g_imageL@file_path <- raster_object - raster_object <- .create_terra_spatraster( - image_path = raster_object - ) - } else { - stop("raster_object needs to be a 'SpatRaster' object from the - terra package or \n an existing path that can be read by - terra::rast()") - } - } - - # Prevent updates to original raster object input - if (getNamespaceVersion("terra") >= "1.15-12") { + if (inherits(raster_object, "SpatRaster")) { + # Prevent updates to original raster object input raster_object <- terra::deepcopy(raster_object) + } else if (is.character(raster_object)) { + checkmate::assert_file_exists(raster_object) + g_imageL@file_path <- raster_object + raster_object <- .create_terra_spatraster(raster_object) } else { - # raster_object = terra::copy(raster_object) - if (isTRUE(verbose)) { - warning("\n If largeImage was created from a terra raster object, - manipulations to the giotto image may be reflected in the - raster object as well. Update terra to >= 1.15-12 to avoid - this issue. \n") - } + # assume class readable by terra rast + raster_object <- .create_terra_spatraster(raster_object) } ## 2. image bound spatial extent - if (use_rast_ext == TRUE) { + if (use_rast_ext) { extent <- terra::ext(raster_object) - if (verbose == TRUE) { - wrap_msg("use_rast_ext == TRUE, extent from input raster_object will - be used.") - } + vmsg(.v = verbose, "use_rast_ext == TRUE + extent from input raster_object will be used.") } # By extent object (priority) @@ -3321,20 +3342,21 @@ createGiottoLargeImage <- function(raster_object, #' #' createGiottoLargeImageList(raster_objects = image_test) #' @export -createGiottoLargeImageList <- function(raster_objects, - names = "image", - negative_y = TRUE, - extent = NULL, - use_rast_ext = FALSE, - image_transformations = NULL, - flip_vertical = FALSE, - flip_horizontal = FALSE, - xmax_bound = NULL, - xmin_bound = NULL, - ymax_bound = NULL, - ymin_bound = NULL, - scale_factor = 1, - verbose = TRUE) { +createGiottoLargeImageList <- function( + raster_objects, + names = "image", + negative_y = TRUE, + extent = NULL, + use_rast_ext = FALSE, + image_transformations = NULL, + flip_vertical = FALSE, + flip_horizontal = FALSE, + xmax_bound = NULL, + xmin_bound = NULL, + ymax_bound = NULL, + ymin_bound = NULL, + scale_factor = 1, + verbose = TRUE) { l_images <- length(raster_objects) l_image_names <- length(unique(names)) diff --git a/R/data_evaluation.R b/R/data_evaluation.R index 075b7458..5fc4f77c 100644 --- a/R/data_evaluation.R +++ b/R/data_evaluation.R @@ -83,11 +83,12 @@ evaluate_input <- function(type, x, ...) { #' @keywords internal #' @returns sparse matrix #' @noRd -.evaluate_expr_matrix <- function(inputmatrix, - sparse = TRUE, - cores = determine_cores(), - feat_type = "rna", - expression_matrix_class = c("dgCMatrix", "DelayedArray")) { +.evaluate_expr_matrix <- function( + inputmatrix, + sparse = TRUE, + cores = determine_cores(), + feat_type = "rna", + expression_matrix_class = c("dgCMatrix", "DelayedArray", "dbSparseMatrix")) { if (inherits(inputmatrix, "character")) { inputmatrix <- path.expand(inputmatrix) mymatrix <- readExprMatrix(inputmatrix, @@ -95,7 +96,9 @@ evaluate_input <- function(type, x, ...) { expression_matrix_class = expression_matrix_class, feat_type = feat_type ) - } else if (expression_matrix_class[1] == "DelayedArray") { + } else if (expression_matrix_class[1] == "dbSparseMatrix") { + mymatrix <- inputmatrix + } else if (expression_matrix_class[1] == "DelayedArray") { mymatrix <- DelayedArray::DelayedArray(inputmatrix) } else if (inherits(inputmatrix, "Matrix")) { mymatrix <- inputmatrix @@ -131,7 +134,8 @@ evaluate_input <- function(type, x, ...) { } else { .gstop( "expression input needs to be a path to matrix-like data or an", - "object of class 'Matrix', 'data.table', 'data.frame' or 'matrix'" + "object of class 'Matrix', 'data.table', 'data.frame', 'matrix'", + "'DelayedMatrix' or 'dbSparseMatrix'." ) } @@ -159,9 +163,10 @@ evaluate_input <- function(type, x, ...) { #' @param cores cores to use if reading in the information #' @keywords internal #' @noRd -.evaluate_cell_metadata <- function(metadata, - cores = determine_cores(), - verbose = TRUE) { +.evaluate_cell_metadata <- function( + metadata, + cores = determine_cores(), + verbose = TRUE) { # data.table vars cell_ID <- NULL @@ -219,9 +224,10 @@ evaluate_input <- function(type, x, ...) { #' @keywords internal #' @noRd -.evaluate_feat_metadata <- function(metadata, - cores = determine_cores(), - verbose = TRUE) { +.evaluate_feat_metadata <- function( + metadata, + cores = determine_cores(), + verbose = TRUE) { # data.table vars feat_ID <- NULL @@ -289,9 +295,10 @@ evaluate_input <- function(type, x, ...) { #' @return data.table #' @keywords internal #' @noRd -.evaluate_spatial_locations <- function(spatial_locs, - cores = determine_cores(), - verbose = TRUE) { +.evaluate_spatial_locations <- function( + spatial_locs, + cores = determine_cores(), + verbose = TRUE) { # data.table variables cell_ID <- NULL @@ -426,10 +433,11 @@ evaluate_input <- function(type, x, ...) { #' compatible with spatEnrObj #' @keywords internal #' @noRd -.evaluate_spatial_enrichment <- function(spatial_enrichment, - provenance = NULL, - cores = determine_cores(), - verbose = TRUE) { +.evaluate_spatial_enrichment <- function( + spatial_enrichment, + provenance = NULL, + cores = determine_cores(), + verbose = TRUE) { # data.table vars cell_ID <- NULL @@ -624,8 +632,9 @@ evaluate_input <- function(type, x, ...) { #' 'poly_ID' if necessary. #' @keywords internal #' @noRd -.evaluate_gpoly_dfr <- function(input_dt, - verbose = TRUE) { +.evaluate_gpoly_dfr <- function( + input_dt, + verbose = TRUE) { x <- y <- poly_ID <- NULL # data.frame like object needs to have 2 coordinate columns and @@ -717,8 +726,9 @@ evaluate_input <- function(type, x, ...) { #' @param verbose be verbose #' @return list of SpatVector and unique_IDs #' @noRd -.evaluate_gpoly_spatvector <- function(input_sv, - verbose = TRUE) { +.evaluate_gpoly_spatvector <- function( + input_sv, + verbose = TRUE) { # determine sv type sv_type <- terra::geomtype(input_sv) @@ -801,11 +811,12 @@ evaluate_input <- function(type, x, ...) { #' @return list of SpatVector and unique polygon IDs that it contains #' @keywords internal #' @noRd -.evaluate_spatial_info <- function(spatial_info, - skip_eval_dfr = FALSE, - copy_dt = TRUE, - cores = determine_cores(), - verbose = TRUE) { +.evaluate_spatial_info <- function( + spatial_info, + skip_eval_dfr = FALSE, + copy_dt = TRUE, + cores = determine_cores(), + verbose = TRUE) { # NSE vars geom <- poly_ID <- NULL @@ -909,10 +920,11 @@ evaluate_input <- function(type, x, ...) { #' @return data.table #' @keywords internal #' @noRd -.evaluate_feat_info <- function(spatial_feat_info, - feat_type, - cores = determine_cores(), - feat_ID) { +.evaluate_feat_info <- function( + spatial_feat_info, + feat_type, + cores = determine_cores(), + feat_ID) { ## 1. load or read spatial information data ## if (inherits(spatial_feat_info, "character")) { if (!file.exists(spatial_feat_info)) { diff --git a/R/data_input.R b/R/data_input.R index 61547e65..86f7b202 100644 --- a/R/data_input.R +++ b/R/data_input.R @@ -23,19 +23,33 @@ #' #' readExprMatrix(paste0(temporal_dir, "/mymatrix.csv")) #' @export -readExprMatrix <- function(path, - cores = determine_cores(), - transpose = FALSE, - feat_type = "rna", - expression_matrix_class = c("dgCMatrix", "DelayedArray")) { +readExprMatrix <- function( + path, + cores = determine_cores(), + transpose = FALSE, + feat_type = "rna", + expression_matrix_class = c("dgCMatrix", "DelayedArray", "dbSparseMatrix")) { # check if path is a character vector and exists if (!is.character(path)) stop("path needs to be character vector") if (!file.exists(path)) stop("the path: ", path, " does not exist") - + + # check if expression_matrix_class is dbMatrix, if so stop and throw error saying not yet supported + if (expression_matrix_class == "dbSparseMatrix"){ + # Note: Implementation of this feature should be done within {dbMatrix} + # See dbMatrix::dbMatrix() function for more info + stop("File conversion to dbMatrix is not yet supported") + } + data.table::setDTthreads(threads = cores) # read and convert - DT <- suppressWarnings(data.table::fread(input = path, nThread = cores)) + DT <- handle_warnings( + data.table::fread( + input = path, + nThread = cores, + colClasses = list(character = 1) # enforce first col character + ) + )$result spM <- Matrix::Matrix(as.matrix(DT[, -1]), dimnames = list(DT[[1]], colnames(DT[, -1])), sparse = TRUE @@ -98,13 +112,14 @@ readExprMatrix <- function(path, #' #' readExprData(paste0(temporal_dir, "/mymatrix.csv")) #' @export -readExprData <- function(data_list, - sparse = TRUE, - cores = determine_cores(), - default_feat_type = NULL, - verbose = TRUE, - provenance = NULL, - expression_matrix_class = c("dgCMatrix", "DelayedArray")) { +readExprData <- function( + data_list, + sparse = TRUE, + cores = determine_cores(), + default_feat_type = NULL, + verbose = TRUE, + provenance = NULL, + expression_matrix_class = c("dgCMatrix", "DelayedArray")) { .read_expression_data( expr_list = data_list, sparse = sparse, @@ -119,14 +134,15 @@ readExprData <- function(data_list, #' @keywords internal #' @noRd -.read_expression_data <- function(expr_list = NULL, - sparse = TRUE, - cores = determine_cores(), - default_spat_unit = NULL, - default_feat_type = NULL, - verbose = TRUE, - provenance = NULL, - expression_matrix_class = c("dgCMatrix", "DelayedArray")) { +.read_expression_data <- function( + expr_list = NULL, + sparse = TRUE, + cores = determine_cores(), + default_spat_unit = NULL, + default_feat_type = NULL, + verbose = TRUE, + provenance = NULL, + expression_matrix_class = c("dgCMatrix", "DelayedArray")) { # import box characters ch <- box_chars() @@ -360,11 +376,12 @@ readExprData <- function(data_list, #' #' readCellMetadata(paste0(temporal_dir, "/metadata.csv")) #' @export -readCellMetadata <- function(data_list, - default_spat_unit = NULL, - default_feat_type = NULL, - provenance = NULL, - verbose = TRUE) { +readCellMetadata <- function( + data_list, + default_spat_unit = NULL, + default_feat_type = NULL, + provenance = NULL, + verbose = TRUE) { .read_cell_metadata( metadata = data_list, default_spat_unit = default_spat_unit, @@ -385,11 +402,12 @@ readCellMetadata <- function(data_list, #' @param verbose be verbose #' @returns cell metadata #' @keywords internal -.read_cell_metadata <- function(metadata, - default_spat_unit = NULL, - default_feat_type = NULL, - provenance = NULL, - verbose = TRUE) { +.read_cell_metadata <- function( + metadata, + default_spat_unit = NULL, + default_feat_type = NULL, + provenance = NULL, + verbose = TRUE) { # data.table vars cell_ID <- NULL @@ -548,11 +566,12 @@ readCellMetadata <- function(data_list, #' #' readFeatMetadata(paste0(temporal_dir, "/metadata.csv")) #' @export -readFeatMetadata <- function(data_list, - default_spat_unit = NULL, - default_feat_type = NULL, - provenance = NULL, - verbose = TRUE) { +readFeatMetadata <- function( + data_list, + default_spat_unit = NULL, + default_feat_type = NULL, + provenance = NULL, + verbose = TRUE) { .read_feature_metadata( metadata = data_list, default_spat_unit = NULL, @@ -567,11 +586,12 @@ readFeatMetadata <- function(data_list, #' @keywords internal #' @noRd -.read_feature_metadata <- function(metadata, - default_spat_unit = NULL, - default_feat_type = NULL, - provenance = NULL, - verbose = TRUE) { +.read_feature_metadata <- function( + metadata, + default_spat_unit = NULL, + default_feat_type = NULL, + provenance = NULL, + verbose = TRUE) { # data.table vars cell_ID <- NULL @@ -738,11 +758,12 @@ readFeatMetadata <- function(data_list, #' #' readSpatLocsData(paste0(temporal_dir, "/spatlocs.csv")) #' @export -readSpatLocsData <- function(data_list, - default_spat_unit = NULL, - provenance = NULL, - cores = determine_cores(), - verbose = TRUE) { +readSpatLocsData <- function( + data_list, + default_spat_unit = NULL, + provenance = NULL, + cores = determine_cores(), + verbose = TRUE) { spatLocsObj_list <- .read_spatial_location_data( spat_loc_list = data_list, default_spat_unit = default_spat_unit, @@ -757,11 +778,12 @@ readSpatLocsData <- function(data_list, #' @noRd -.read_spatial_location_data <- function(spat_loc_list, - default_spat_unit = NULL, - provenance = NULL, - cores = determine_cores(), - verbose = TRUE) { +.read_spatial_location_data <- function( + spat_loc_list, + default_spat_unit = NULL, + provenance = NULL, + cores = determine_cores(), + verbose = TRUE) { # data.table vars cell_ID <- NULL @@ -943,10 +965,11 @@ readSpatLocsData <- function(data_list, #' #' readSpatNetData(x) #' @export -readSpatNetData <- function(data_list, - default_spat_unit = NULL, - provenance = NULL, - verbose = TRUE) { +readSpatNetData <- function( + data_list, + default_spat_unit = NULL, + provenance = NULL, + verbose = TRUE) { .read_spatial_networks( spatial_network = data_list, default_spat_unit = default_spat_unit, @@ -960,10 +983,11 @@ readSpatNetData <- function(data_list, #' @keywords internal #' @noRd -.read_spatial_networks <- function(spatial_network, - default_spat_unit = NULL, - provenance = NULL, - verbose = TRUE) { +.read_spatial_networks <- function( + spatial_network, + default_spat_unit = NULL, + provenance = NULL, + verbose = TRUE) { if (is.null(spatial_network)) { wrap_msg("No spatial networks are provided") return(NULL) @@ -1124,11 +1148,12 @@ readSpatNetData <- function(data_list, #' #' readSpatEnrichData(x) #' @export -readSpatEnrichData <- function(data_list, - default_spat_unit = NULL, - default_feat_type = NULL, - provenance = NULL, - verbose = TRUE) { +readSpatEnrichData <- function( + data_list, + default_spat_unit = NULL, + default_feat_type = NULL, + provenance = NULL, + verbose = TRUE) { .read_spatial_enrichment( spatial_enrichment = data_list, default_spat_unit = default_spat_unit, @@ -1143,11 +1168,12 @@ readSpatEnrichData <- function(data_list, #' @keywords internal #' @noRd -.read_spatial_enrichment <- function(spatial_enrichment, - default_spat_unit = NULL, - default_feat_type = NULL, - provenance = NULL, - verbose = TRUE) { +.read_spatial_enrichment <- function( + spatial_enrichment, + default_spat_unit = NULL, + default_feat_type = NULL, + provenance = NULL, + verbose = TRUE) { if (is.null(spatial_enrichment)) { message("No spatial enrichment results are provided") return(NULL) @@ -1423,12 +1449,13 @@ readSpatEnrichData <- function(data_list, #' #' readDimReducData(x) #' @export -readDimReducData <- function(data_list, - default_spat_unit = NULL, - default_feat_type = NULL, - reduction = c("cells", "feats"), - provenance = NULL, - verbose = TRUE) { +readDimReducData <- function( + data_list, + default_spat_unit = NULL, + default_feat_type = NULL, + reduction = c("cells", "feats"), + provenance = NULL, + verbose = TRUE) { reduction <- match.arg(reduction, choices = c("cells", "feats")) .read_dimension_reduction( @@ -1445,12 +1472,13 @@ readDimReducData <- function(data_list, #' @keywords internal #' @noRd -.read_dimension_reduction <- function(dimension_reduction, - default_spat_unit = NULL, - default_feat_type = NULL, - reduction = c("cells", "feats"), - provenance = NULL, - verbose = TRUE) { +.read_dimension_reduction <- function( + dimension_reduction, + default_spat_unit = NULL, + default_feat_type = NULL, + reduction = c("cells", "feats"), + provenance = NULL, + verbose = TRUE) { reduction <- match.arg(reduction, choices = c("cells", "feats")) if (is.null(dimension_reduction)) { @@ -1733,11 +1761,12 @@ readDimReducData <- function(data_list, #' #' readNearestNetData(x) #' @export -readNearestNetData <- function(data_list, - default_spat_unit = NULL, - default_feat_type = NULL, - provenance = NULL, - verbose = TRUE) { +readNearestNetData <- function( + data_list, + default_spat_unit = NULL, + default_feat_type = NULL, + provenance = NULL, + verbose = TRUE) { .read_nearest_networks( nn_network = data_list, default_spat_unit = default_spat_unit, @@ -1751,11 +1780,12 @@ readNearestNetData <- function(data_list, #' @keywords internal #' @noRd -.read_nearest_networks <- function(nn_network, - default_spat_unit = NULL, - default_feat_type = NULL, - provenance = NULL, - verbose = TRUE) { +.read_nearest_networks <- function( + nn_network, + default_spat_unit = NULL, + default_feat_type = NULL, + provenance = NULL, + verbose = TRUE) { if (is.null(nn_network)) { message("No nearest network results are provided") return(NULL) @@ -2042,13 +2072,14 @@ readNearestNetData <- function(data_list, #' #' readPolygonData(x) #' @export -readPolygonData <- function(data_list, - default_name = "cell", - input = "guess", - polygon_mask_list_params = NULL, - polygon_dfr_list_params = NULL, - calc_centroids = FALSE, - verbose = TRUE) { +readPolygonData <- function( + data_list, + default_name = "cell", + input = "guess", + polygon_mask_list_params = NULL, + polygon_dfr_list_params = NULL, + calc_centroids = FALSE, + verbose = TRUE) { if (is.null(data_list)) { message("No polygon data/spatial info is provided") return(NULL) @@ -2117,12 +2148,13 @@ readPolygonData <- function(data_list, #' @param verbose be verbose #' @keywords internal #' @noRd -.extract_polygon_list <- function(polygonlist, - input = "guess", - default_name = "cell", - polygon_mask_list_params, - polygon_dfr_list_params, - verbose = TRUE) { +.extract_polygon_list <- function( + polygonlist, + input = "guess", + default_name = "cell", + polygon_mask_list_params, + polygon_dfr_list_params, + verbose = TRUE) { named_list <- FALSE # if polygonlist is not a named list @@ -2250,8 +2282,9 @@ readPolygonData <- function(data_list, #' #' g <- addGiottoPolygons(gobject = g, gpolygons = list(x)) #' @export -addGiottoPolygons <- function(gobject, - gpolygons) { +addGiottoPolygons <- function( + gobject, + gpolygons) { # check input assert_giotto(gobject) @@ -2307,8 +2340,9 @@ addGiottoPolygons <- function(gobject, #' #' readFeatData(list(x)) #' @export -readFeatData <- function(data_list, - verbose = TRUE) { +readFeatData <- function( + data_list, + verbose = TRUE) { if (is.null(data_list)) { message("No feature info is provided") return(NULL) @@ -2333,8 +2367,9 @@ readFeatData <- function(data_list, #' @keywords internal #' @returns name list of `giottoPoints` objects #' @noRd -.extract_points_list <- function(pointslist, - verbose = TRUE) { +.extract_points_list <- function( + pointslist, + verbose = TRUE) { named_list <- FALSE # if pointslist is not a named list @@ -2447,8 +2482,9 @@ NULL #' #' g <- addGiottoPoints(gobject = g, gpoints = list(x_points)) #' @export -addGiottoPoints <- function(gobject, - gpoints) { +addGiottoPoints <- function( + gobject, + gpoints) { # check input if (!inherits(gobject, "giotto")) { stop("gobject needs to be a giotto object") diff --git a/R/dd.R b/R/dd.R index 9fa6a593..20df8a7d 100644 --- a/R/dd.R +++ b/R/dd.R @@ -30,13 +30,17 @@ #' @param gobject giotto object #' @param spat_unit spatial unit (e.g. "cell") #' @param feat_type feature type (e.g. "rna", "dna", "protein") -#' @param return_uniques return unique nesting names (ignores if final object exists/is correct class) +#' @param return_uniques return unique nesting names (ignores if final object +#' exists/is correct class) #' @param output what format in which to get information (e.g. "data.table") -#' @param set_defaults set default spat_unit and feat_type. Change to FALSE only when +#' @param set_defaults set default spat_unit and feat_type. Change to FALSE +#' only when #' expression and spat_info are not expected to exist. -#' @param copy_obj whether to deep copy/duplicate when getting the object (default = TRUE) +#' @param copy_obj whether to deep copy/duplicate when getting the object +#' (default = TRUE) #' @param initialize (default = FALSE) whether to initialize the gobject before #' returning +#' @param \dots additional params to pass #' @keywords internal #' @returns data.table NULL diff --git a/R/defaults.R b/R/defaults.R index ed20f370..ec2f7607 100644 --- a/R/defaults.R +++ b/R/defaults.R @@ -14,8 +14,9 @@ #' #' set_default_spat_unit(gobject = g, spat_unit = "cell") #' @export -set_default_spat_unit <- function(gobject, - spat_unit = NULL) { +set_default_spat_unit <- function( + gobject, + spat_unit = NULL) { # If a spatial unit is provided, use it directly if (!is.null(spat_unit)) { if (!inherits(spat_unit, "character")) { @@ -56,9 +57,10 @@ set_default_spat_unit <- function(gobject, #' #' set_default_feat_type(gobject = g, spat_unit = "cell", feat_type = "rna") #' @export -set_default_feat_type <- function(gobject, - feat_type = NULL, - spat_unit) { +set_default_feat_type <- function( + gobject, + feat_type = NULL, + spat_unit) { # if a feature type is provided, use it directly if (!is.null(feat_type)) { if (!inherits(feat_type, "character")) { diff --git a/R/flex_functions.R b/R/flex_functions.R index 01ca6140..01ad9de2 100644 --- a/R/flex_functions.R +++ b/R/flex_functions.R @@ -30,6 +30,8 @@ mean_flex <- function(x, ...) { return(Matrix::mean(x, ...)) # replace with sparseMatrixStats } else if (inherits(x, "Matrix")) { return(Matrix::mean(x, ...)) + } else if (inherits(x, "dbMatrix")) { + return(dbMatrix::mean(x)) } else { return(base::mean(x, ...)) } @@ -56,6 +58,8 @@ rowSums_flex <- function(mymatrix) { return(Matrix::rowSums(mymatrix)) # replace with sparseMatrixStats } else if (inherits(mymatrix, "Matrix")) { return(Matrix::rowSums(mymatrix)) + } else if (inherits(mymatrix, "dbMatrix")) { + return(dbMatrix::rowSums(mymatrix)) } else { temp_matrix <- as.matrix(mymatrix) temp_res <- matrixStats::rowSums2(temp_matrix) @@ -86,6 +90,8 @@ rowMeans_flex <- function(mymatrix) { return(Matrix::rowMeans(mymatrix)) # replace with sparseMatrixStats } else if (inherits(mymatrix, "Matrix")) { return(Matrix::rowMeans(mymatrix)) + } else if (inherits(mymatrix, "dbMatrix")) { + return(dbMatrix::rowMeans(mymatrix)) } else { temp_matrix <- as.matrix(mymatrix) temp_res <- matrixStats::rowMeans2(temp_matrix) @@ -115,6 +121,8 @@ colSums_flex <- function(mymatrix) { return(Matrix::colSums(mymatrix)) # replace with sparseMatrixStats } else if (inherits(mymatrix, "Matrix")) { return(Matrix::colSums(mymatrix)) + } else if (inherits(mymatrix, "dbMatrix")) { + return(dbMatrix::colSums(mymatrix)) } else { temp_matrix <- as.matrix(mymatrix) temp_res <- matrixStats::colSums2(temp_matrix) @@ -144,6 +152,8 @@ colMeans_flex <- function(mymatrix) { return(Matrix::colMeans(mymatrix)) # replace with sparseMatrixStats } else if (inherits(mymatrix, "Matrix")) { return(Matrix::colMeans(mymatrix)) + } else if (inherits(mymatrix, "dbMatrix")) { + return(dbMatrix::colMeans(mymatrix)) } else { temp_matrix <- as.matrix(mymatrix) temp_res <- matrixStats::colMeans2(temp_matrix) @@ -172,6 +182,8 @@ t_flex <- function(mymatrix) { return(Matrix::t(mymatrix)) # replace with sparseMatrixStats } else if (inherits(mymatrix, "Matrix")) { return(Matrix::t(mymatrix)) + } else if(inherits(mymatrix, 'dbMatrix')) { + return(t(mymatrix)) } else if (inherits(mymatrix, "spatLocsObj")) { return(t(mymatrix)) } else if (inherits(mymatrix, "spatialNetworkObj")) { diff --git a/R/function_logging.R b/R/function_logging.R index 122fb2cb..5e805ea2 100644 --- a/R/function_logging.R +++ b/R/function_logging.R @@ -11,7 +11,7 @@ #' @param description description of function run #' @param return_gobject logical. Whether the giotto object should be returned #' @param toplevel expected relative stackframe where call that is being -#' recorded was made +#' recorded was made. If negative, param recording is skipped #' @returns giotto object or list of parameters #' @examples #' g <- GiottoData::loadGiottoMini("visium") @@ -22,6 +22,10 @@ update_giotto_params <- function(gobject, description = "_test", return_gobject = TRUE, toplevel = 2) { + if (toplevel < 0) { + return(gobject) + } # skip if toplevel negative + parameters_list <- gobject@parameters number_of_rounds <- length(parameters_list) update_name <- paste0(number_of_rounds, description) @@ -42,15 +46,34 @@ update_giotto_params <- function(gobject, #' @name objHistory #' @description Print and return giotto object history #' @param object giotto object +#' @param summarized logical. whether print should be summarized #' @returns list #' @examples #' g <- GiottoData::loadGiottoMini("visium") #' #' objHistory(g) +#' objHistory(g, summarized = TRUE) #' @export -objHistory <- function(object) { - message("Steps and parameters used:") - message(object@parameters) +objHistory <- function(object, summarized = FALSE) { + p <- object@parameters + + if (summarized) { + message("Processing steps:") + for (step in names(p)) { + message(step) + sub_step <- p[[step]] + if (any(grepl("name", names(sub_step)) == TRUE)) { + selected_names <- grep("name", names(sub_step), value = TRUE) + wrap_msg("\t name info: ", sub_step[selected_names]) + } + } + } else { + message("Steps and parameters used:") + for (i in seq_along(p)) { + cat(GiottoUtils::color_blue(sprintf("<%s>\n", names(p)[[i]]))) + GiottoUtils::print_list(p[[i]], pre = " ") + } + } invisible(x = object@parameters) } @@ -68,6 +91,13 @@ objHistory <- function(object) { #' showProcessingSteps(g) #' @export showProcessingSteps <- function(gobject) { + deprecate_warn( + when = "0.4.0", + what = "showProcessingSteps()", + with = "objHistory()", + details = "objHistory with arg `summarized = TRUE` replaces this functionality" + ) + parameters <- gobject@parameters message("Processing steps:") diff --git a/R/generate_poly.R b/R/generate_poly.R index 8a8695ae..babc2fcf 100644 --- a/R/generate_poly.R +++ b/R/generate_poly.R @@ -40,12 +40,13 @@ #' #' @seealso [generate_grid] [tessellate] #' @export -polyStamp <- function(stamp_dt, - spatlocs, - id_col = "cell_ID", - x_col = "sdimx", - y_col = "sdimy", - verbose = TRUE) { +polyStamp <- function( + stamp_dt, + spatlocs, + id_col = "cell_ID", + x_col = "sdimx", + y_col = "sdimy", + verbose = TRUE) { # data.table vars spatlocs_idx <- rel_vertices_idx <- poly_ID <- NULL @@ -120,8 +121,9 @@ polyStamp <- function(stamp_dt, #' @examples #' circleVertices(radius = 10) #' @export -circleVertices <- function(radius, - npoints = 25) { +circleVertices <- function( + radius, + npoints = 25) { a <- seq(0, 2 * pi, length.out = npoints + 1) x <- radius * cos(a) y <- radius * sin(a) @@ -248,13 +250,14 @@ hexVertices <- function(radius, major_axis = c("v", "h")) { #' plot(x) #' @concept spatial location #' @export -tessellate <- function(extent, - shape = c("hexagon", "square"), - shape_size = NULL, - gap = 0, - radius = NULL, - id_prefix = "ID_", - name = "grid") { +tessellate <- function( + extent, + shape = c("hexagon", "square"), + shape_size = NULL, + gap = 0, + radius = NULL, + id_prefix = "ID_", + name = "grid") { if (is.null(radius) && is.null(shape_size)) stop("shape_size must be given") if (!is.null(radius)) shape_size <- radius * 2 @@ -382,26 +385,46 @@ orthoGrid <- function(extent, ccd, id_prefix = "ID_") { #' @title makePseudoVisium #' @name makePseudoVisium -#' @description Generates a pseudo-visium grid of spots across a provided -#' spatial extent +#' @description Generates a visium-like array of spots across a provided +#' spatial extent. #' @param extent SpatExtent or anything else a SpatExtent can be extracted or #' created from -#' @param micron_size size of a micrometer relative to spatial coordinates +#' @param micron_scale scalefactor needed to convert the target coordinate +#' space to microns. For supported datasets, this can be found from +#' `instructions(gobject, "micron_scale")`. See details. +#' @param micron_size deprecated. Use `micron_scale` #' @param name character. (default is 'pseudo_visium') Name of giottoPolygon #' object to create -#' @details This function generates a pseudo-Visium grid of spots based on the -#' input spatial locations. The micron_size param is used to determine the size -#' of the spots +#' @details This function generates a pseudo-Visium array of spots across the +#' spatial extent provided. The `micron_scale` param is used to determine the +#' scaling of the array relative to the target coordinate system. +#' +#' @section `micron_scale`: +#' If `a` is microns and `b` is dataset coordinate units, `micron_scale` is +#' calculated as `a / b`. #' @returns A giottoPolygon for the pseudo-visium spots. #' @examples #' e <- ext(0, 2000, 0, 2000) -#' x <- makePseudoVisium(extent = e, micron_size = 1) +#' x <- makePseudoVisium(extent = e, micron_scale = 1) #' plot(x) #' @concept spatial location #' @export -makePseudoVisium <- function(extent = NULL, - micron_size = 1, - name = "pseudo_visium") { +makePseudoVisium <- function( + extent = NULL, + micron_scale = 1, + micron_size = deprecated(), + name = "pseudo_visium") { + if (is_present(micron_size)) { + micron_size <- 1 / micron_size + } + + micron_scale <- deprecate_param( + x = micron_size, + y = micron_scale, + when = "0.4.2", + fun = "makePseudoVisium" + ) + e <- ext(extent)[] # Visium default scale parameters @@ -410,19 +433,23 @@ makePseudoVisium <- function(extent = NULL, visium_gap_um <- 45 # Compute metrics to visium scale - radius <- visium_radius_um / micron_size + cc <- visium_center_center_dist_um / micron_scale + radius <- visium_radius_um / micron_scale gap <- (visium_gap_um / visium_radius_um) * radius # Define a data.table with the vertices of a circle centered around (0,0) stamp_dt <- circleVertices(radius = radius, npoints = 100) # Create a grid of y points where the circles will be centered - y_seq <- seq(e[["ymin"]] + radius, e[["ymax"]] - radius, - by = 2 * radius + gap + y_seq <- seq( + e[["ymin"]] + radius, + e[["ymax"]] - radius, + # should be sqrt(3) or 1.732051, but seems like it was rounded + by = 1.74 * (cc / 2) ) # Stagger center point of circles to match visium staggered grid - centers <- data.table::rbindlist(lapply(seq_len(length(y_seq)), function(i) { + dt_list <- lapply(seq_len(length(y_seq)), function(i) { x_start <- if (i %% 2 == 0) { e[["xmin"]] + radius + (2 * radius + gap) / 2 } else { @@ -430,7 +457,8 @@ makePseudoVisium <- function(extent = NULL, } x_seq <- seq(x_start, e[["xmax"]] - radius, by = 2 * radius + gap) data.table::data.table(sdimx = x_seq, sdimy = y_seq[i]) - })) + }) + centers <- data.table::rbindlist(dt_list) centers$cell_ID <- paste0("spot_", seq_len(nrow(centers))) # Call polyStamp function on centers to generate the pseudo-visium grid diff --git a/R/generics.R b/R/generics.R index 6b76b940..bcfec55b 100644 --- a/R/generics.R +++ b/R/generics.R @@ -33,14 +33,6 @@ setGeneric( ) -# Methods and documentations found in methods-spatShift.R -setGeneric("spatShift", function(x, ...) standardGeneric("spatShift")) -setGeneric("affine", function(x, y, ...) standardGeneric("affine")) -setGeneric("shear", function(x, ...) standardGeneric("shear")) - -# Methods and documentations found in methods-overlaps.R -setGeneric("overlaps", function(x, ...) standardGeneric("overlaps")) - # Object creation #### setGeneric( @@ -64,7 +56,6 @@ setGeneric("reconnect", function(x, ...) standardGeneric("reconnect")) if (!isGeneric("nrow")) setOldClass("nrow") if (!isGeneric("ncol")) setOldClass("ncol") if (!isGeneric("dim")) setOldClass("dim") -# if(!isGeneric('t')) setOldClass('t', where = as.environment("package:Giotto")) ## colnames and rownames generics #### if (!isGeneric("colnames")) setOldClass("colnames") @@ -78,6 +69,11 @@ setGeneric("copy", ) +# lazy operations #### +setGeneric("doDeferred", function(x, ...) standardGeneric("doDeferred")) + + + # spatial operations #### setGeneric( "calculateOverlap", @@ -89,6 +85,20 @@ setGeneric( ) +setGeneric("spatShift", function(x, ...) standardGeneric("spatShift")) +setGeneric("affine", function(x, y, ...) standardGeneric("affine")) +setGeneric("shear", function(x, ...) standardGeneric("shear")) +setGeneric("XY", function(x, ...) standardGeneric("XY")) +setGeneric("XY<-", function(x, ..., value) standardGeneric("XY<-")) +setGeneric("settleGeom", function(x, ...) standardGeneric("settleGeom")) +if (!isGeneric("area")) { + setGeneric("area", function(x, ...) standardGeneric("area")) +} + +# Methods and documentations found in methods-overlaps.R +setGeneric("overlaps", function(x, ...) standardGeneric("overlaps")) + + # Giotto subnesting #### # All methods and documentations found in methods-nesting.R diff --git a/R/giotto_structures.R b/R/giotto_structures.R index 5d03cc95..35921946 100644 --- a/R/giotto_structures.R +++ b/R/giotto_structures.R @@ -90,9 +90,10 @@ #' @description calculates centroids from selected polygons #' @keywords internal #' @returns SpatVector or giotto polygon -.calculate_centroids_polygons <- function(gpolygon, - name = "centroids", - append_gpolygon = TRUE) { +.calculate_centroids_polygons <- function( + gpolygon, + name = "centroids", + append_gpolygon = TRUE) { terra_polygon_centroids <- terra::centroids(slot(gpolygon, "spatVector")) if (isTRUE(append_gpolygon)) { @@ -168,7 +169,9 @@ # from a spatvector, get the centroid xy values as a numeric vector .get_centroid_xy <- function(x) { - res <- centroids(x) %>% ext() %>% .ext_to_num_vec() + res <- centroids(x) %>% + ext() %>% + .ext_to_num_vec() res[c(1L, 3L)] } @@ -185,7 +188,7 @@ .magick_image_corners <- function(x) { checkmate::assert_class(x, "magick-image") im_info <- magick::image_info(x) - + # generate spatLocsObj as a set of control points for magick distort. # # ------------------------------------------------------------------- # # - magick uses 0.5 to refer to the center of pixels @@ -347,11 +350,12 @@ combineToMultiPolygon <- function(x, groups, name = NULL) { #' #' smoothGiottoPolygons(gpolygon = gpoly) #' @export -smoothGiottoPolygons <- function(gpolygon, - vertices = 20, - k = 3, - set_neg_to_zero = TRUE, - ...) { +smoothGiottoPolygons <- function( + gpolygon, + vertices = 20, + k = 3, + set_neg_to_zero = TRUE, + ...) { # NSE vars x <- NULL y <- NULL @@ -445,12 +449,11 @@ smoothGiottoPolygons <- function(gpolygon, #' @param verbose be verbose #' @returns SpatVector #' @keywords internal -.create_spatvector_object_from_dfr <- function( - x, - x_colname = NULL, - y_colname = NULL, - feat_ID_colname = NULL, - verbose = TRUE) { +.create_spatvector_object_from_dfr <- function(x, + x_colname = NULL, + y_colname = NULL, + feat_ID_colname = NULL, + verbose = NULL) { x <- data.table::as.data.table(x) # MANUAL OPTION @@ -522,27 +525,26 @@ smoothGiottoPolygons <- function(gpolygon, } ## message and force data type - if (isTRUE(verbose)) { - message(paste0( - ' Selecting col "', - colnames(x[, feat_ID_col, with = FALSE]), - '" as feat_ID column' - )) - } + vmsg( + .v = verbose, .initial = " ", + sprintf( + "Selecting col \"%s\" as feat_ID column", + colnames(x[, feat_ID_col, with = FALSE]) + ) + ) colnames(x)[feat_ID_col] <- "feat_ID" if (!inherits(x$feat_ID, "character")) { x$feat_ID <- as.character(x$feat_ID) # ensure char } - - if (isTRUE(verbose)) { - message(paste0( - ' Selecting cols "', - colnames(x[, x_col, with = FALSE]), '" and "', - colnames(x[, y_col, with = FALSE]), - '" as x and y respectively' - )) - } + vmsg( + .v = verbose, .initial = " ", + sprintf( + "Selecting cols \"%s\" and \"%s\" as x and y respectively", + colnames(x[, x_col, with = FALSE]), + colnames(x[, y_col, with = FALSE]) + ) + ) colnames(x)[x_col] <- "x" colnames(x)[y_col] <- "y" if (!inherits(x$x, "numeric")) x$x <- as.numeric(x$x) # ensure numeric @@ -589,15 +591,16 @@ smoothGiottoPolygons <- function(gpolygon, #' @param ... additional parameters to pass to \code{\link[dbscan]{kNN}} #' @returns kNN spatial feature network #' @keywords internal -createSpatialFeaturesKNNnetwork_dbscan <- function(gobject, - feat_type = NULL, - name = "knn_feats_network", - k = 4, - maximum_distance = NULL, - minimum_k = 0, - add_feat_ids = FALSE, - verbose = TRUE, - ...) { +createSpatialFeaturesKNNnetwork_dbscan <- function( + gobject, + feat_type = NULL, + name = "knn_feats_network", + k = 4, + maximum_distance = NULL, + minimum_k = 0, + add_feat_ids = FALSE, + verbose = TRUE, + ...) { # define for data.table from_feat <- from <- to_feat <- to <- from_to_feat <- NULL @@ -717,18 +720,19 @@ createSpatialFeaturesKNNnetwork_dbscan <- function(gobject, #' #' createSpatialFeaturesKNNnetwork(g) #' @export -createSpatialFeaturesKNNnetwork <- function(gobject, - method = "dbscan", - feat_type = NULL, - name = "knn_feats_network", - k = 4, - maximum_distance = NULL, - minimum_k = 0, - add_feat_ids = FALSE, - verbose = TRUE, - return_gobject = TRUE, - toplevel_params = 2, - ...) { +createSpatialFeaturesKNNnetwork <- function( + gobject, + method = "dbscan", + feat_type = NULL, + name = "knn_feats_network", + k = 4, + maximum_distance = NULL, + minimum_k = 0, + add_feat_ids = FALSE, + verbose = TRUE, + return_gobject = TRUE, + toplevel_params = 2, + ...) { # 1. select feat_type if (is.null(feat_type)) { feat_type <- gobject@expression_feat[[1]] @@ -807,12 +811,13 @@ createSpatialFeaturesKNNnetwork <- function(gobject, #' #' addSpatialCentroidLocationsLayer(g, poly_info = "aggregate") #' @export -addSpatialCentroidLocationsLayer <- function(gobject, - poly_info = "cell", - feat_type = NULL, - provenance = poly_info, - spat_loc_name = "raw", - return_gobject = TRUE) { +addSpatialCentroidLocationsLayer <- function( + gobject, + poly_info = "cell", + feat_type = NULL, + provenance = poly_info, + spat_loc_name = "raw", + return_gobject = TRUE) { # data.table vars x <- y <- poly_ID <- NULL @@ -931,13 +936,14 @@ addSpatialCentroidLocationsLayer <- function(gobject, #' #' addSpatialCentroidLocations(g, poly_info = "aggregate") #' @export -addSpatialCentroidLocations <- function(gobject, - poly_info = "cell", - feat_type = NULL, - spat_loc_name = "raw", - provenance = poly_info, - return_gobject = TRUE, - verbose = TRUE) { +addSpatialCentroidLocations <- function( + gobject, + poly_info = "cell", + feat_type = NULL, + spat_loc_name = "raw", + provenance = poly_info, + return_gobject = TRUE, + verbose = TRUE) { # provenance setup # # Require that provenance is a user-provided named list if length of # poly_info is greater than 1. diff --git a/R/globals.R b/R/globals.R index 7c6a770e..c970f382 100644 --- a/R/globals.R +++ b/R/globals.R @@ -1,10 +1,10 @@ -utils::globalVariables( +globalVariables( names = c( ":=", ".N", ".SD", ".", "cast", "python_leiden", "python_louvain", "python_spatial_genes", "Spatial_DE_AEH", "Spatial_DE", "silhouette_rank", "python_scrublet", "python_create_mesmer_app", - "python_segment_image", + "python_segment_image", # anndata interop "ad_guard", "dir_guard", "ad_obj", "lay_inv", "set_adg_layer_data", "set_adg_spat_locs", @@ -17,7 +17,7 @@ utils::globalVariables( "extract_layered_data", "set_adg_nn", "find_NN_keys", "extract_NN_connectivities", "extract_NN_distances", "extract_NN_info", "align_network_data", "extract_SN_connectivities", - "extract_SN_distances", "set_adg_sn", "create_AnnData", + "extract_SN_distances", "set_adg_sn", "create_AnnData", # tifffile "ometif_2_tif", # spatialdata interop diff --git a/R/gstop.R b/R/gstop.R index 1a34d948..050a1a04 100644 --- a/R/gstop.R +++ b/R/gstop.R @@ -2,14 +2,15 @@ # .n should be increased when called from a nested location if capturing the # original call is desired. # .n should be increased to 2L when within a generic method -.gstop <- function(..., - sep = " ", - strWidth = 100, - errWidth = FALSE, - .prefix = " ", - .initial = "", - .n = 1L, - .call = TRUE) { +.gstop <- function( + ..., + sep = " ", + strWidth = 100, + errWidth = FALSE, + .prefix = " ", + .initial = "", + .n = 1L, + .call = TRUE) { GiottoUtils::gstop( ..., sep = sep, diff --git a/R/images.R b/R/images.R index 40a18b52..ab3804ce 100644 --- a/R/images.R +++ b/R/images.R @@ -12,7 +12,8 @@ #' mgimg <- as(g_image, "giottoImage") #' #' a <- convert_mgImage_to_array_DT(mgimg) -#' force(a);force(a) +#' force(a) +#' force(a) #' @export convert_mgImage_to_array_DT <- function(mg_object) { if (inherits(mg_object, "giottoImage")) { @@ -87,11 +88,12 @@ estimateImageBg <- function(mg_object, top_color_range = seq_len(50)) { #' #' changeImageBg(mg_object = g_image, bg_color = "white") #' @export -changeImageBg <- function(mg_object, - bg_color, - perc_range = 10, - new_color = "#FFFFFF", - new_name = NULL) { +changeImageBg <- function( + mg_object, + bg_color, + perc_range = 10, + new_color = "#FFFFFF", + new_name = NULL) { if (inherits(mg_object, "giottoImage")) { is_g_image <- TRUE g_image <- mg_object @@ -192,10 +194,11 @@ changeImageBg <- function(mg_object, #' #' get_img_minmax(slot(mgimg, "mg_object")) #' @export -get_img_minmax <- function(mg_img, - negative_y = TRUE) { +get_img_minmax <- function( + mg_img, + negative_y = TRUE) { deprecate_soft(what = "get_img_minmax()", with = "ext()", when = "0.3.1") - + # Get magick object dimensions. xmin and ymax assumed to be 0. info <- magick::image_info(mg_img) img_xmax <- info$width # width @@ -232,17 +235,19 @@ get_img_minmax <- function(mg_img, #' #' get_adj_rescale_img(img_minmax = minmax, spatial_locs = g_spatlocs) #' @export -get_adj_rescale_img <- function(img_minmax, - spatial_locs, - scale_factor = 1) { +get_adj_rescale_img <- function( + img_minmax, + spatial_locs, + scale_factor = 1) { deprecate_warn( - "0.3.1", what = "get_adj_rescale_img()", + "0.3.1", + what = "get_adj_rescale_img()", details = c( "this is too specific to the inner workings of `giottoImage`", "We can simply use `ext<-` to set a new extent instead of this." ) ) - + # Expand scale_factor if needed if (length(scale_factor) == 1) { scale_factor <- c(x = scale_factor, y = scale_factor) @@ -277,17 +282,22 @@ get_adj_rescale_img <- function(img_minmax, } # save a magick image to disk and return the filepath -# can be loaded in with terra or used with getOption("viewer")() downstream +# can be loaded in with terra or used with getOption("viewer")() downstream # based on magick:::image_preview() # accepts a single `magick-image` object -.magick_preview <- function(x, tempname = "preview") { +# only returns depth 8 images. DO NOT use for analyzed values +.magick_preview <- function(x, + basename = "preview", + filename = NULL) { stopifnot(inherits(x, "magick-image")) stopifnot(length(x) == 1L) format <- tolower(magick::image_info(x[1])$format) - tmp <- file.path(tempdir(), paste(tempname, format, sep = ".")) + if (is.null(filename)) { + filename <- file.path(tempdir(), paste(basename, format, sep = ".")) + } vmsg(.is_debug = TRUE, "`.magick_preview()` saving as", format) - image_write(x, path = tmp, format = format, depth = 8) - return(tmp) + magick::image_write(x, path = filename, format = format, depth = 8) + return(filename) } #' @title addGiottoImageMG @@ -311,12 +321,13 @@ get_adj_rescale_img <- function(img_minmax, #' #' addGiottoImageMG(g, images = list(g_image)) #' @export -addGiottoImageMG <- function(gobject, - images, - spat_unit = NULL, - spat_loc_name = NULL, - scale_factor = NULL, - negative_y = TRUE) { +addGiottoImageMG <- function( + gobject, + images, + spat_unit = NULL, + spat_loc_name = NULL, + scale_factor = NULL, + negative_y = TRUE) { # 0. check params if (is.null(gobject)) { stop("The giotto object that will be updated needs to be provided") @@ -483,25 +494,26 @@ addGiottoImageMG <- function(gobject, #' #' updateGiottoImageMG(g, giottoImage = g_image) #' @export -updateGiottoImageMG <- function(gobject = NULL, - image_name = NULL, - giottoImage = NULL, - xmax_adj = 0, - xmin_adj = 0, - ymax_adj = 0, - ymin_adj = 0, - x_shift = 0, - y_shift = 0, - scale_factor = NULL, - scale_x = 1, - scale_y = 1, - order = c("first_adj", "first_scale"), - xmin_set = NULL, - xmax_set = NULL, - ymin_set = NULL, - ymax_set = NULL, - return_gobject = TRUE, - verbose = TRUE) { +updateGiottoImageMG <- function( + gobject = NULL, + image_name = NULL, + giottoImage = NULL, + xmax_adj = 0, + xmin_adj = 0, + ymax_adj = 0, + ymin_adj = 0, + x_shift = 0, + y_shift = 0, + scale_factor = NULL, + scale_x = 1, + scale_y = 1, + order = c("first_adj", "first_scale"), + xmin_set = NULL, + xmax_set = NULL, + ymin_set = NULL, + ymax_set = NULL, + return_gobject = TRUE, + verbose = TRUE) { # 0. Check params # Check input image if (is.null(gobject)) { @@ -647,9 +659,8 @@ updateGiottoImageMG <- function(gobject = NULL, #' @returns reconnected giottoImage #' @keywords internal #' @export -reconnect_giottoImage_MG <- function( - giottoImage, - image_path) { +reconnect_giottoImage_MG <- function(giottoImage, + image_path) { deprecate_soft("0.2.4", "reconnect_giottoImage_MG()", "reconnect()") # load in new magick object @@ -674,7 +685,7 @@ reconnect_giottoImage_MG <- function( #' @keywords internal #' @returns spatRaster object .create_terra_spatraster <- function(image_path) { - raster_object <- try(suppressWarnings(terra::rast(x = image_path))) + raster_object <- try(handle_warnings(terra::rast(x = image_path))$result) if (inherits(raster_object, "try-error")) { stop(raster_object, " can not be read by terra::rast() \n") } @@ -699,11 +710,12 @@ reconnect_giottoImage_MG <- function( #' @param \dots additional params to pass to `terra::spatSample` #' @returns magick or EBImage image #' @keywords internal -.spatraster_sample_values <- function(raster_object, - size = 5000, - output = c("data.frame", "array", "magick", "EBImage"), - verbose = NULL, - ...) { +.spatraster_sample_values <- function( + raster_object, + size = 5000, + output = c("data.frame", "array", "magick", "EBImage"), + verbose = NULL, + ...) { output <- match.arg( arg = output, choices = c("data.frame", "array", "magick", "EBImage") @@ -771,9 +783,8 @@ reconnect_giottoImage_MG <- function( #' @keywords internal #' @noRd #' @return named numeric vector of min then max detected values -.spatraster_intensity_range <- function( - raster_object, - sample_values = .spatraster_sample_values(raster_object)) { +.spatraster_intensity_range <- function(raster_object, + sample_values = .spatraster_sample_values(raster_object)) { # get intensity range srMinmax <- suppressWarnings(terra::minmax(raster_object)) if (sum(is.infinite(srMinmax)) == 0) { # pull minmax values from terra @@ -796,9 +807,8 @@ reconnect_giottoImage_MG <- function( #' @keywords internal #' @noRd #' @return logical -.spatraster_is_int <- function( - raster_object, - sample_values = .spatraster_sample_values(raster_object)) { +.spatraster_is_int <- function(raster_object, + sample_values = .spatraster_sample_values(raster_object)) { # find out if image is int or floating point identical(sample_values, round(sample_values)) } @@ -816,12 +826,11 @@ reconnect_giottoImage_MG <- function( #' @param ... additional params to pass #' @returns density or histogram plot #' @keywords internal -.dist_giottolargeimage <- function( - gobject = NULL, - image_name = NULL, - giottoLargeImage = NULL, - method = "dens", - ...) { +.dist_giottolargeimage <- function(gobject = NULL, + image_name = NULL, + giottoLargeImage = NULL, + method = "dens", + ...) { # get image object if (!is.null(gobject) & !is.null(image_name)) { img_obj <- getGiottoImage( @@ -927,21 +936,22 @@ reconnect_giottoImage_MG <- function( #' #' stitchGiottoLargeImage(largeImage_list = list(g_image)) #' @export -stitchGiottoLargeImage <- function(largeImage_list = NULL, - gobject_list = NULL, - largeImage_nameList = NULL, - FOV_positions = NULL, - FOV_xcol = NULL, - FOV_ycol = NULL, - FOV_inverty = FALSE, - method = c("mosaic", "merge"), - round_positions = FALSE, - filename = NULL, - dataType = NULL, - fileType = NULL, - dryRun = TRUE, - overwrite = FALSE, - verbose = TRUE) { +stitchGiottoLargeImage <- function( + largeImage_list = NULL, + gobject_list = NULL, + largeImage_nameList = NULL, + FOV_positions = NULL, + FOV_xcol = NULL, + FOV_ycol = NULL, + FOV_inverty = FALSE, + method = c("mosaic", "merge"), + round_positions = FALSE, + filename = NULL, + dataType = NULL, + fileType = NULL, + dryRun = TRUE, + overwrite = FALSE, + verbose = TRUE) { ## 0. Check params if (!is.null(gobject_list)) { # Set default largeImage_nameList @@ -1133,15 +1143,16 @@ stitchGiottoLargeImage <- function(largeImage_list = NULL, #' #' cropGiottoLargeImage(g, largeImage_name = "image") #' @export -cropGiottoLargeImage <- function(gobject = NULL, - largeImage_name = NULL, - giottoLargeImage = NULL, - crop_name = "image", - crop_extent = NULL, - xmax_crop = NULL, - xmin_crop = NULL, - ymax_crop = NULL, - ymin_crop = NULL) { +cropGiottoLargeImage <- function( + gobject = NULL, + largeImage_name = NULL, + giottoLargeImage = NULL, + crop_name = "image", + crop_extent = NULL, + xmax_crop = NULL, + xmin_crop = NULL, + ymax_crop = NULL, + ymin_crop = NULL) { ## 0. Check inputs if (!is.null(crop_extent)) { if (!inherits(crop_extent, "SpatExtent")) { @@ -1233,21 +1244,22 @@ cropGiottoLargeImage <- function(gobject = NULL, #' #' convertGiottoLargeImageToMG(g, largeImage_name = "image") #' @export -convertGiottoLargeImageToMG <- function(gobject = NULL, - largeImage_name = NULL, - giottoLargeImage = NULL, - mg_name = NULL, - spat_unit = NULL, - spat_loc_name = NULL, - crop_extent = NULL, - xmax_crop = NULL, - xmin_crop = NULL, - ymax_crop = NULL, - ymin_crop = NULL, - resample_size = 500000, - max_intensity = NULL, - return_gobject = TRUE, - verbose = TRUE) { +convertGiottoLargeImageToMG <- function( + gobject = NULL, + largeImage_name = NULL, + giottoLargeImage = NULL, + mg_name = NULL, + spat_unit = NULL, + spat_loc_name = NULL, + crop_extent = NULL, + xmax_crop = NULL, + xmin_crop = NULL, + ymax_crop = NULL, + ymin_crop = NULL, + resample_size = 500000, + max_intensity = NULL, + return_gobject = TRUE, + verbose = TRUE) { # Check params if (is.null(gobject)) { if (return_gobject == TRUE) { @@ -1414,14 +1426,15 @@ convertGiottoLargeImageToMG <- function(gobject = NULL, #' @param verbose be verbose #' @keywords internal #' @returns datatype for terra writeRaster function -.terra_writeraster_datatype <- function(giottoLargeImage = NULL, - quick_INTS_maxval = NULL, - max_intensity = NULL, - min_intensity = NULL, - is_int = NULL, - signed = NULL, - bitDepth = NULL, - verbose = TRUE) { +.terra_writeraster_datatype <- function( + giottoLargeImage = NULL, + quick_INTS_maxval = NULL, + max_intensity = NULL, + min_intensity = NULL, + is_int = NULL, + signed = NULL, + bitDepth = NULL, + verbose = TRUE) { # 1. Get any missing metadata from giottoLargeImage object if given if (!is.null(giottoLargeImage)) { if (is.null(max_intensity)) { @@ -1572,14 +1585,15 @@ convertGiottoLargeImageToMG <- function(gobject = NULL, #' filename = paste0("tempfile()", ".png") #' ) #' @export -writeGiottoLargeImage <- function(giottoLargeImage = NULL, - gobject = NULL, - largeImage_name = NULL, - filename = NULL, - dataType = NULL, - max_intensity = NULL, - overwrite = FALSE, - verbose = TRUE) { +writeGiottoLargeImage <- function( + giottoLargeImage = NULL, + gobject = NULL, + largeImage_name = NULL, + filename = NULL, + dataType = NULL, + max_intensity = NULL, + overwrite = FALSE, + verbose = TRUE) { # 0. Check params if (!is.null(giottoLargeImage)) { if (!inherits(giottoLargeImage, "giottoLargeImage")) { @@ -1686,26 +1700,27 @@ writeGiottoLargeImage <- function(giottoLargeImage = NULL, #' updateGiottoLargeImage(g, largeImage_name = "image") #' @seealso [ext()] #' @export -updateGiottoLargeImage <- function(gobject = NULL, - largeImage_name = NULL, - giottoLargeImage = NULL, - xmax_adj = 0, - xmin_adj = 0, - ymax_adj = 0, - ymin_adj = 0, - x_shift = 0, - y_shift = 0, - scale_factor = NULL, - scale_x = 1, - scale_y = 1, - order = c("first_adj", "first_scale"), # TODO make this a list of - # operations to perform, include rotation - xmin_set = NULL, - xmax_set = NULL, - ymin_set = NULL, - ymax_set = NULL, - return_gobject = TRUE, - verbose = TRUE) { +updateGiottoLargeImage <- function( + gobject = NULL, + largeImage_name = NULL, + giottoLargeImage = NULL, + xmax_adj = 0, + xmin_adj = 0, + ymax_adj = 0, + ymin_adj = 0, + x_shift = 0, + y_shift = 0, + scale_factor = NULL, + scale_x = 1, + scale_y = 1, + order = c("first_adj", "first_scale"), # TODO make this a list of + # operations to perform, include rotation + xmin_set = NULL, + xmax_set = NULL, + ymin_set = NULL, + ymax_set = NULL, + return_gobject = TRUE, + verbose = TRUE) { # 0. Check params # Check input image if (is.null(gobject)) { @@ -1867,12 +1882,13 @@ updateGiottoLargeImage <- function(gobject = NULL, #' #' addGiottoLargeImage(g, largeImages = list(g_image)) #' @export -addGiottoLargeImage <- function(gobject = NULL, - largeImages = NULL, - spat_loc_name = NULL, - scale_factor = NULL, - negative_y = TRUE, - verbose = TRUE) { +addGiottoLargeImage <- function( + gobject = NULL, + largeImages = NULL, + spat_loc_name = NULL, + scale_factor = NULL, + negative_y = TRUE, + verbose = TRUE) { # 0. check params if (is.null(gobject)) { stop("The giotto object that will be updated needs to be provided") @@ -1941,9 +1957,8 @@ addGiottoLargeImage <- function(gobject = NULL, #' @returns reconnected giottoLargeImage #' @keywords internal #' @export -reconnect_giottoLargeImage <- function( - giottoLargeImage, - image_path) { +reconnect_giottoLargeImage <- function(giottoLargeImage, + image_path) { deprecate_soft("0.2.4", "reconnect_giottoLargeImage()", "reconnect()") # load in new terra raster objects @@ -2007,14 +2022,15 @@ reconnect_giottoLargeImage <- function( #' largeImage_max_intensity = 200 #' ) #' @export -plotGiottoImage <- function(gobject = NULL, - image_name = NULL, - image_type = NULL, - giottoImage = NULL, - giottoLargeImage = NULL, - largeImage_crop_params_list = NULL, - largeImage_max_intensity = NULL, - ...) { +plotGiottoImage <- function( + gobject = NULL, + image_name = NULL, + image_type = NULL, + giottoImage = NULL, + giottoLargeImage = NULL, + largeImage_crop_params_list = NULL, + largeImage_max_intensity = NULL, + ...) { # Check params if (!is.null(giottoImage) && !is.null(giottoLargeImage)) { stop("Only one of a giottoImage or a giottoLargeImage can be plotted @@ -2027,8 +2043,8 @@ plotGiottoImage <- function(gobject = NULL, gobject = gobject, name = image_name ) - if (inherits(img_obj, "giottoLargeImage")) image_type = "largeImage" - if (inherits(img_obj, "giottoImage")) image_type = "image" + if (inherits(img_obj, "giottoLargeImage")) image_type <- "largeImage" + if (inherits(img_obj, "giottoImage")) image_type <- "image" } if (!is.null(giottoImage)) { img_obj <- giottoImage @@ -2081,12 +2097,13 @@ plotGiottoImage <- function(gobject = NULL, #' #' addGiottoImage(g, largeImages = list(g_image)) #' @export -addGiottoImage <- function(gobject = NULL, - images = NULL, - largeImages = NULL, - spat_loc_name = NULL, - scale_factor = NULL, - negative_y = TRUE) { +addGiottoImage <- function( + gobject = NULL, + images = NULL, + largeImages = NULL, + spat_loc_name = NULL, + scale_factor = NULL, + negative_y = TRUE) { if (!is.null(largeImages)) { deprecate_warn( when = "0.3.0", @@ -2159,25 +2176,26 @@ addGiottoImage <- function(gobject = NULL, #' #' updateGiottoImage(g, largeImage_name = "image") #' @export -updateGiottoImage <- function(gobject = NULL, - image_name = NULL, - largeImage_name = NULL, - xmax_adj = 0, - xmin_adj = 0, - ymax_adj = 0, - ymin_adj = 0, - x_shift = 0, - y_shift = 0, - scale_factor = NULL, - scale_x = 1, - scale_y = 1, - order = c("first_adj", "first_scale"), - xmax_set = NULL, - xmin_set = NULL, - ymax_set = NULL, - ymin_set = NULL, - return_gobject = TRUE, - verbose = TRUE) { +updateGiottoImage <- function( + gobject = NULL, + image_name = NULL, + largeImage_name = NULL, + xmax_adj = 0, + xmin_adj = 0, + ymax_adj = 0, + ymin_adj = 0, + x_shift = 0, + y_shift = 0, + scale_factor = NULL, + scale_x = 1, + scale_y = 1, + order = c("first_adj", "first_scale"), + xmax_set = NULL, + xmin_set = NULL, + ymax_set = NULL, + ymin_set = NULL, + return_gobject = TRUE, + verbose = TRUE) { # 0. Check params if (is.null(gobject)) { stop("The giotto object that will be updated needs to be provided \n") @@ -2255,10 +2273,9 @@ updateGiottoImage <- function(gobject = NULL, #' @param image_path path to image source to reconnect image object with #' @returns reconnected image_object #' @keywords internal -reconnect_image_object <- function( - image_object, - image_type, - image_path) { +reconnect_image_object <- function(image_object, + image_type, + image_path) { deprecate_soft("0.2.4", "reconnect_image_object()", "reconnect()") image_object <- reconnect( @@ -2310,14 +2327,15 @@ reconnect_image_object <- function( #' #' reconnectGiottoImage(g, reconnect_type = "largeImage") #' @export -reconnectGiottoImage <- function(gobject, - auto_reconnect = TRUE, - reconnect_type = c("all", "image", "largeImage"), - image_name = NULL, - largeImage_name = NULL, - image_path = NULL, - largeImage_path = NULL, - verbose = TRUE) { +reconnectGiottoImage <- function( + gobject, + auto_reconnect = TRUE, + reconnect_type = c("all", "image", "largeImage"), + image_name = NULL, + largeImage_name = NULL, + image_path = NULL, + largeImage_path = NULL, + verbose = TRUE) { # Adding image_types: # Manual workflow needs to be updated when adding more image types @@ -2596,14 +2614,13 @@ reconnectGiottoImage <- function(gobject, #' #' distGiottoImage(g, image_name = "image") #' @export -distGiottoImage <- function( - gobject = NULL, - image_type = "largeImage", - image_name = NULL, - giottoLargeImage = NULL, - method = c("dens", "hist"), - show_max = TRUE, - ...) { +distGiottoImage <- function(gobject = NULL, + image_type = "largeImage", + image_name = NULL, + giottoLargeImage = NULL, + method = c("dens", "hist"), + show_max = TRUE, + ...) { # check params if (image_type != "largeImage") { stop("Only largeImage objects currently supported \n") @@ -2659,11 +2676,11 @@ setMethod( .density_giottolargeimage <- function(x, show_max = TRUE, ...) { a <- list(x = x@raster_object, ...) res <- do.call(terra::density, args = a) - + if (isFALSE(a$plot)) { return(res) } - + if (isTRUE(show_max)) { graphics::abline(v = x@max_window, col = "red") } @@ -2719,8 +2736,9 @@ setMethod( #' #' add_img_array_alpha(x, alpha = 0.1) #' @export -add_img_array_alpha <- function(x, - alpha) { +add_img_array_alpha <- function( + x, + alpha) { img_dims <- dim(x) x_alpha <- array(data = alpha, dim = c(img_dims[1], img_dims[2], 4)) x_alpha[, , seq_len(3)] <- x @@ -2730,6 +2748,40 @@ add_img_array_alpha <- function(x, + +# doDeferred #### + +#' @name doDeferred +#' @title Perform deferred/lazy operations +#' @description Force deferred/lazy operations. +#' @param x object to force deferred operations in +#' @param ... additional args to pass +NULL + +#' @rdname doDeferred +#' @param size numeric. Minimum number of image pixels to render when +#' evaluating +#' @param filename character. Full filepath to write the rendered image to. If +#' `NULL`, a file in `tempdir()` will be generated. +#' @examples +#' gimg <- GiottoData::loadSubObjectMini("giottoLargeImage") +#' affimg <- spin(gimg, 45) # lazily performs affine +#' +#' # force the affine operation and render the output with at least 5e5 px +#' gimg2 <- doDeferred(affimg, size = 5e5) +#' # **This is mainly intended for visualization.** +#' # This process saves with image depth of 8. +#' # Spatially transformed raster values are not preferred for analysis +#' @export +setMethod( + "doDeferred", signature("giottoAffineImage"), + function(x, size = 5e5, filename = NULL, ...) { + x@funs$realize_magick(filename = filename, size = size, ...) + } +) + + + # converters #### @@ -2749,18 +2801,19 @@ add_img_array_alpha <- function(x, #' @returns returns the written filepath invisibly #' @family ometif utility functions #' @export -ometif_to_tif <- function(input_file, - output_dir = file.path(dirname(input_file), "tif_exports"), - page, - overwrite = FALSE) { +ometif_to_tif <- function( + input_file, + output_dir = file.path(dirname(input_file), "tif_exports"), + page, + overwrite = FALSE) { a <- list(input_file = input_file) # get tifffile py package_check( - pkg_name = c("tifffile", "imagecodecs"), + pkg_name = c("tifffile", "imagecodecs"), repository = c("pip:tifffile", "pip:imagecodecs") ) - + ometif2tif_path <- system.file( "python", "ometif_convert.py", package = "GiottoClass" @@ -2819,15 +2872,13 @@ ometif_to_tif <- function(input_file, #' @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 #' 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 +#' 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 #' @export -ometif_metadata <- function( - path, node = NULL, output = c("data.frame", "xml", "list", "structure") -) { +ometif_metadata <- function(path, node = NULL, output = c("data.frame", "xml", "list", "structure")) { checkmate::assert_file_exists(path) package_check( pkg_name = c("tifffile", "xml2"), @@ -2837,25 +2888,26 @@ ometif_metadata <- function( TIF <- reticulate::import("tifffile", convert = TRUE, delay_load = TRUE) img <- TIF$TiffFile(path) output <- match.arg( - output, choices = c("data.frame", "xml", "list", "structure") + output, + choices = c("data.frame", "xml", "list", "structure") ) x <- xml2::read_xml(img$ome_metadata) if (!is.null(node)) { node <- paste(node, collapse = "/") x <- xml2::xml_find_all( - x, sprintf("//d1:%s", node), + x, sprintf("//d1:%s", node), ns = xml2::xml_ns(x) ) } - + switch(output, "data.frame" = { - x = Reduce("rbind", xml2::xml_attrs(x)) + x <- Reduce("rbind", xml2::xml_attrs(x)) rownames(x) <- NULL x <- as.data.frame(x) return(x) - }, + }, "xml" = return(x), "list" = return(xml2::as_list(x)), "structure" = { @@ -2864,7 +2916,3 @@ ometif_metadata <- function( } ) } - - - - diff --git a/R/instructions.R b/R/instructions.R index 32d714db..20553914 100644 --- a/R/instructions.R +++ b/R/instructions.R @@ -3,7 +3,7 @@ #' @rdname giotto_instructions #' @param python_path path to python binary to use or directory one level -#' up from the `env` directory (similar to output of +#' up from the `env` directory (similar to output of #' `reticulate::miniconda_path()`) #' @param show_plot print plot to console, default = TRUE #' @param return_plot return plot as object, default = TRUE @@ -22,20 +22,20 @@ #' been detected #' @export createGiottoInstructions <- function( - python_path = getOption("giotto.py_path"), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_dir = NULL, - plot_format = NULL, - dpi = NULL, - units = NULL, - height = NULL, - width = NULL, - is_docker = FALSE, - plot_count = 0, - fiji_path = NULL, - no_python_warn = FALSE) { + python_path = getOption("giotto.py_path"), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_dir = NULL, + plot_format = NULL, + dpi = NULL, + units = NULL, + height = NULL, + width = NULL, + is_docker = FALSE, + plot_count = 0, + fiji_path = NULL, + no_python_warn = FALSE) { # python path to use # try used here to allow instructions to be made in the absence of a # compatible python env @@ -52,7 +52,8 @@ createGiottoInstructions <- function( if ((is.null(python_path) || inherits(python_path, "try-error")) & !no_python_warn) { warning(wrap_txt("Python is required for full Giotto functionality."), - call. = FALSE) + call. = FALSE + ) options("giotto.has_conda" = FALSE) } @@ -139,17 +140,18 @@ createGiottoInstructions <- function( #' @keywords internal -create_giotto_instructions <- function(python_path = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_dir = NULL, - plot_format = NULL, - dpi = NULL, - units = NULL, - height = NULL, - width = NULL, - is_docker = NULL) { +create_giotto_instructions <- function( + python_path = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_dir = NULL, + plot_format = NULL, + dpi = NULL, + units = NULL, + height = NULL, + width = NULL, + is_docker = NULL) { instructions_list <- list( python_path = python_path, show_plot = show_plot, @@ -190,16 +192,16 @@ create_giotto_instructions <- function(python_path = NULL, #' ) #' @export #' @keywords internal -readGiottoInstructions <- function(giotto_instructions, - param = NULL, - default) { - +readGiottoInstructions <- function( + giotto_instructions, + param = NULL, + default) { deprecate_soft( when = "0.3.5", what = "readGiottoInstructions()", with = "instructions()" ) - + # get instructions if provided the giotto object if (inherits(giotto_instructions, "giotto")) { giotto_instructions <- giotto_instructions@instructions @@ -232,13 +234,12 @@ readGiottoInstructions <- function(giotto_instructions, #' @export #' @keywords internal showGiottoInstructions <- function(gobject) { - deprecate_soft( when = "0.3.5", what = "showGiottoInstructions()", with = "instructions()" ) - + instrs <- gobject@instructions return(instrs) } @@ -264,19 +265,19 @@ showGiottoInstructions <- function(gobject) { #' ) #' @export #' @keywords internal -changeGiottoInstructions <- function(gobject, - params = NULL, - new_values = NULL, - return_gobject = TRUE, - init_gobject = TRUE) { - +changeGiottoInstructions <- function( + gobject, + params = NULL, + new_values = NULL, + return_gobject = TRUE, + init_gobject = TRUE) { deprecate_soft( when = "0.3.5", what = "changeGiottoInstructions()", with = "instructions()" ) - - + + instrs <- gobject@instructions if (is.null(params) | is.null(new_values)) { @@ -342,16 +343,16 @@ changeGiottoInstructions <- function(gobject, #' ) #' @export #' @keywords internal -replaceGiottoInstructions <- function(gobject, - instructions = NULL, - init_gobject = TRUE) { - +replaceGiottoInstructions <- function( + gobject, + instructions = NULL, + init_gobject = TRUE) { deprecate_soft( when = "0.3.5", what = "replaceGiottoInstructions()", with = "instructions()" ) - + instrs_needed <- names(create_giotto_instructions()) # validate new instructions @@ -375,6 +376,3 @@ print.giottoInstructions <- function(x, ...) { cat(sprintf("<%s>\n", class(x)[1])) print_list(x) } - - - diff --git a/R/interoperability.R b/R/interoperability.R index 8253a337..a1750d75 100644 --- a/R/interoperability.R +++ b/R/interoperability.R @@ -22,84 +22,82 @@ #' @returns giotto object #' @export -gefToGiotto <- function( - gef_file, - bin_size = "bin100", - verbose = FALSE, - h5_file = NULL) { - # data.table vars - genes <- gene_idx <- x <- y <- sdimx <- sdimy <- cell_ID <- bin_ID <- - count <- i.bin_ID <- NULL - - # package check - package_check(pkg_name = "rhdf5", repository = "Bioc") - if (!file.exists(gef_file)) stop("File path to .gef file does not exist") - - # check if proper bin_size is selected. These are determined in SAW pipeline - wrap_msg("1. gefToGiotto() begin... \n") - bin_size_options <- c("bin1", "bin10", "bin20", "bin50", "bin100", "bin200") - if (!(bin_size %in% bin_size_options)) { - stop("Please select valid bin size, see ?gefToGiotto for details.") - } - - # 1. read .gef file at specific bin size - geneExpData <- rhdf5::h5read( - file = gef_file, - name = paste0("geneExp/", bin_size) - ) - geneDT <- data.table::as.data.table(geneExpData[["gene"]]) - - exprDT <- data.table::as.data.table(geneExpData[["expression"]]) - exprDT[, count := lapply(.SD, as.integer), .SDcols = "count"] - data.table::setorder(exprDT, x, y) # sort by x, y coords (ascending) - geneDT <- data.table::as.data.table(geneExpData[["gene"]]) - - if (isTRUE(verbose)) wrap_msg("finished reading in .gef", bin_size, "\n") - - # 2. create spatial locations - if (isTRUE(verbose)) wrap_msg("2. create spatial_locations... \n") - cell_locations <- unique(exprDT[, c("x", "y")], by = c("x", "y")) - cell_locations[, bin_ID := as.factor(seq_len(nrow(cell_locations)))] - cell_locations[, cell_ID := paste0("cell_", bin_ID)] - data.table::setcolorder(cell_locations, c("x", "y", "cell_ID", "bin_ID")) - # ensure first non-numerical col is cell_ID - if (isTRUE(verbose)) wrap_msg(nrow(cell_locations), " bins in total \n") - if (isTRUE(verbose)) wrap_msg("finished spatial_locations \n") - - # 3. create expression matrix - if (isTRUE(verbose)) wrap_msg("3. create expression matrix... \n") - exprDT[, genes := as.character(rep(x = geneDT$gene, geneDT$count))] - exprDT[, gene_idx := as.integer(factor(exprDT$genes, - levels = unique(exprDT$genes) - ))] - - # merge on x,y and populate based on bin_ID values in cell_locations - exprDT[cell_locations, cell_ID := i.bin_ID, on = .(x, y)] - exprDT$cell_ID <- as.integer(exprDT$cell_ID) - - expMatrix <- Matrix::sparseMatrix( - i = exprDT$gene_idx, - j = exprDT$cell_ID, - x = exprDT$count - ) - - colnames(expMatrix) <- cell_locations$cell_ID - rownames(expMatrix) <- geneDT$gene - rm(exprDT) - if (isTRUE(verbose)) wrap_msg("finished expression matrix") - - # 4. create minimal giotto object - if (isTRUE(verbose)) wrap_msg("4. create giotto object... \n") - stereo <- createGiottoObject( - expression = expMatrix, - spatial_locs = cell_locations, - verbose = FALSE, - h5_file = h5_file - ) - if (isTRUE(verbose)) wrap_msg("finished giotto object... \n") - - wrap_msg("gefToGiotto() finished \n") - return(stereo) +gefToGiotto <- function(gef_file, + bin_size = "bin100", + verbose = FALSE, + h5_file = NULL) { + # data.table vars + genes <- gene_idx <- x <- y <- sdimx <- sdimy <- cell_ID <- bin_ID <- + count <- i.bin_ID <- NULL + + # package check + package_check(pkg_name = "rhdf5", repository = "Bioc") + if (!file.exists(gef_file)) stop("File path to .gef file does not exist") + + # check if proper bin_size is selected. These are determined in SAW pipeline + wrap_msg("gefToGiotto() begin...") + bin_size_options <- c("bin1", "bin10", "bin20", "bin50", "bin100", "bin200") + if (!(bin_size %in% bin_size_options)) { + stop("Please select valid bin size, see ?gefToGiotto for details.") + } + + # 1. read .gef file at specific bin size + exprDT <- rhdf5::h5read( + file = gef_file, + name = paste0("geneExp/", bin_size, "/expression") + ) + data.table::setDT(exprDT) + exprDT[, cell_id := paste0("cell_", x, "_", y)] + + if (verbose) wrap_msg("\n finished reading in .gef", bin_size, "\n") + + # 2. create spatial locations + if (verbose) wrap_msg("\n create spatial_locations... \n") + cell_locations <- unique(exprDT[, c("x", "y")], by = c("x", "y")) + cell_locations[, cell_ID := paste0("cell_", x, "_", y)] + if (verbose) wrap_msg("\n",nrow(cell_locations), " bins in total \n") + if (verbose) wrap_msg("\n finished spatial_locations \n") + + # 3. create expression matrix + if (verbose) wrap_msg("\n create expression matrix... \n") + geneDT <- rhdf5::h5read( + file = gef_file, + name = paste0("geneExp/", bin_size, "/gene") + ) + data.table::setDT(geneDT) + + # Map genes to expression data + exprDT[, genes := rep(geneDT$gene, geneDT$count)] + + # Create gene and cell indices + exprDT[, `:=`( + gene_idx = as.integer(factor(genes)), + cell_idx = as.integer(factor(cell_id)) + )] + + gene_names <- levels(factor(exprDT$genes)) + cell_names <- levels(factor(exprDT$cell_id)) + + expMatrix <- Matrix::sparseMatrix( + i = exprDT$gene_idx, + j = exprDT$cell_idx, + x = as.integer(exprDT$count), + dimnames = list(gene_names, cell_names) + ) + if (verbose) wrap_msg("\n finished expression matrix") + + # 4. create minimal giotto object + if (verbose) wrap_msg("\n create giotto object... \n") + stereo <- createGiottoObject( + expression = expMatrix, + spatial_locs = cell_locations, + verbose = FALSE, + h5_file = h5_file + ) + if (verbose) wrap_msg("\n finished giotto object... \n") + + wrap_msg("finished \n") + return(stereo) } @@ -109,7 +107,6 @@ gefToGiotto <- function( #' @title Check Scanpy Installation #' @name check_py_for_scanpy -#' @import reticulate #' @returns character #' @description checks current python environment for scanpy 1.9.0 #' @keywords internal @@ -226,7 +223,7 @@ anndataToGiotto <- function( instrs <- createGiottoInstructions(python_path = python_path) package_check( - pkg_name = c("anndata", "scanpy"), + pkg_name = c("anndata", "scanpy"), repository = c("pip:anndata", "pip:scanpy") ) @@ -616,7 +613,7 @@ giottoToAnnData <- function( } package_check( - pkg_name = c("anndata", "scanpy"), + pkg_name = c("anndata", "scanpy"), repository = c("pip:anndata", "pip:scanpy") ) @@ -769,7 +766,7 @@ giottoToAnnData <- function( # Feat Metadata for (su in spat_unit) { for (ft in names(gobject@expression[[su]])) { - cmeta <- get_cell_metadata( + cmeta <- getCellMetadata( gobject = gobject, spat_unit = su, feat_type = ft, @@ -777,7 +774,7 @@ giottoToAnnData <- function( set_defaults = FALSE ) - fm <- get_feature_metadata( + fm <- getFeatureMetadata( gobject = gobject, spat_unit = su, feat_type = ft, @@ -1296,7 +1293,7 @@ giottoToSeuratV4 <- function( } # add cell metadata meta_cells <- data.table::setDF( - get_cell_metadata( + getCellMetadata( gobject = gobject, spat_unit = spat_unit, feat_type = assay_use, @@ -1314,7 +1311,7 @@ giottoToSeuratV4 <- function( ) # add feature metadata meta_genes <- data.table::setDF( - get_feature_metadata( + getFeatureMetadata( gobject = gobject, spat_unit = spat_unit, feat_type = assay_use, @@ -1470,11 +1467,11 @@ giottoToSeuratV4 <- function( #' @returns Seurat object #' @keywords seurat interoperability #' @export -giottoToSeuratV5 <- function( - gobject, - spat_unit = NULL, - res_type = c("hires", "lowres", "fullres"), - ...) { +giottoToSeuratV5 <- function(gobject, + spat_unit = NULL, + dataType, + res_type = c("hires", "lowres", "fullres"), + ...) { # data.table vars feat_type <- name <- dim_type <- nn_type <- NULL @@ -1485,6 +1482,13 @@ giottoToSeuratV5 <- function( gobject = gobject, spat_unit = spat_unit ) + assay_names <- names(gobject@expression$cell) + + # Identify assays with spaces and replace with underscores + new_assay_names <- gsub(" ", "_", assay_names) + + # Apply the new names to the gobject expression slot + names(gobject@expression$cell) <- new_assay_names # verify if optional package is installed package_check(pkg_name = "Seurat", repository = "CRAN") @@ -1577,8 +1581,9 @@ giottoToSeuratV5 <- function( } # add cell metadata + names(gobject@cell_metadata$cell) <- gsub(" ", "_", names(gobject@cell_metadata$cell)) meta_cells <- data.table::setDF( - get_cell_metadata( + getCellMetadata( gobject = gobject, spat_unit = spat_unit, feat_type = assay_use, @@ -1587,21 +1592,22 @@ giottoToSeuratV5 <- function( ) ) rownames(meta_cells) <- meta_cells$cell_ID - meta_cells <- meta_cells[, -which(colnames(meta_cells) == "cell_ID")] + meta_cells <- meta_cells[, -which(colnames(meta_cells) == "cell_ID"), drop = FALSE] if (ncol(meta_cells) > 0) { colnames(meta_cells) <- paste0( assay_use, "_", colnames(meta_cells) ) + sobj <- Seurat::AddMetaData(sobj, + metadata = meta_cells[Seurat::Cells(sobj), ], + col.name = names(meta_cells) + ) } - sobj <- Seurat::AddMetaData(sobj, - metadata = meta_cells[Seurat::Cells(sobj), ], - col.name = names(meta_cells) - ) # add feature metadata + names(gobject@feat_metadata$cell) <- gsub(" ", "_", names(gobject@feat_metadata$cell)) meta_genes <- data.table::setDF( - get_feature_metadata( + getFeatureMetadata( gobject = gobject, spat_unit = spat_unit, feat_type = assay_use, @@ -1610,16 +1616,14 @@ giottoToSeuratV5 <- function( ) ) rownames(meta_genes) <- meta_genes$feat_ID - for (i in seq_along(sobj@assays)) { - - # Check if assay_slot has @meta.data or @meta.features - if ("meta.data" %in% slotNames(sobj@assays[[i]])) { - sobj@assays[[i]]@meta.data <- meta_genes - } else if ("meta.features" %in% slotNames(sobj@assays[[i]])) { - sobj@assays[[i]]@meta.features <- meta_genes - } else { - warning(paste("No suitable metadata slot found for assay", i)) - } + if ("meta.data" %in% slotNames(sobj@assays[[assay_use]])) { + sobj@assays[[assay_use]]@meta.data <- meta_genes + message(paste("Meta data updated for assay:", assay_use)) + } else if ("meta.features" %in% slotNames(sobj@assays[[assay_use]])) { + sobj@assays[[assay_use]]@meta.features <- meta_genes + message(paste("Meta features updated for assay:", assay_use)) + } else { + warning(paste("No suitable metadata slot found for assay", assay_use)) } # dim reduction @@ -1717,8 +1721,8 @@ giottoToSeuratV5 <- function( # flip y vals - loc_use <- flip(loc_use)[] %>% - data.table::setDF() + loc_use <- flip(loc_use)[] %>% + data.table::setDF() rownames(loc_use) <- loc_use$cell_ID sobj <- Seurat::AddMetaData(sobj, metadata = loc_use) @@ -1767,27 +1771,27 @@ giottoToSeuratV5 <- function( gimgs <- getGiottoImage(gobject, name = ":all:") if (length(gimgs) > 0) { - for (i in seq_along(gimgs)) { - gimg <- gimgs[[i]] - key <- objName(gimg) - imagerow <- loc_use$sdimy - imagecol <- loc_use$sdimx - img_array <- as(gimg, "array") - img_array <- img_array / 255 - coord <- data.frame( - imagerow = imagerow, imagecol = imagecol, - row.names = loc_use$cell_ID - ) - scalef <- .estimate_scalefactors( - gimg, - res_type = res_type, - spatlocs = loc_use - ) - # There does not seem to be a way to tell seurat which image type - # you are using. The lowres scalefactor seems to be the important - # one in mapping the image + for (i in seq_along(gimgs)) { + gimg <- gimgs[[i]] + key <- objName(gimg) + imagerow <- loc_use$sdimy + imagecol <- loc_use$sdimx + img_array <- as(gimg, "array") + img_array <- img_array / 255 + coord <- data.frame( + imagerow = imagerow, imagecol = imagecol, + row.names = loc_use$cell_ID + ) + scalef <- .estimate_scalefactors( + gimg, + res_type = res_type, + spatlocs = loc_use + ) + # There does not seem to be a way to tell seurat which image type + # you are using. The lowres scalefactor seems to be the important + # one in mapping the image scalefactors <- Seurat::scalefactors( - spot = scalef$spot, + spot = scalef$spot, fiducial = scalef$fiducial, hires = scalef$hires, lowres = scalef[res_type] # this looks like the main one @@ -1796,17 +1800,36 @@ giottoToSeuratV5 <- function( # since we allow use non-lowres images ) # see https://github.com/satijalab/seurat/issues/3595 - newV1 <- new( - Class = "VisiumV1", - image = img_array, - scale.factors = scalefactors, - coordinates = coord, - spot.radius = - scalef$fiducial * scalef$lowres / max(dim(img_array)), - key = paste0(key, "_") - ) - - sobj@images[[key]] <- newV1 + if (dataType != 0){ + if(dataType == "xenium"){ + coord1 <- coord + coord$cell_id <- rownames(coord) + coord <- coord[, c("cell_id", "imagerow", "imagecol")] + segmentations.data <- list( + "centroids" = SeuratObject::CreateCentroids(coord1), + "segmentation" = SeuratObject::CreateSegmentation(coord) + ) + coords <- SeuratObject::CreateFOV( + coords = segmentations.data, + type = c("segmentation", "centroids"), + assay = "rna") + fov <- "default_fov" + sobj[[fov]] <- coords + }else{ + newV1 <- new( + Class = "VisiumV1", + image = img_array, + scale.factors = scalefactors, + coordinates = coord, + spot.radius = + scalef$fiducial * scalef$lowres / max(dim(img_array)), + key = paste0(key, "_") + ) + + sobj@images[[key]] <- newV1 + } + } + } } @@ -1820,68 +1843,65 @@ giottoToSeuratV5 <- function( #' @param spatlocs a data.frame of spatial locations coordinates #' @noRd -.estimate_scalefactors <- function( - x, +.estimate_scalefactors <- function(x, res_type = c("hires", "lowres", "fullres"), - spatlocs - ){ - res_type <- match.arg(res_type, - choices = c("hires", "lowres", "fullres")) - pxdims <- dim(x)[1:2] - edims <- range(ext(x)) - scalef <- mean(pxdims / edims) -# assume that lowres and hires follow a general ratio -# may not be that important since the scalefactor should theoretically -# only matter for the image res that we are using -# this ratio is roughly 3.333334 based on Visium BreastCancerA1 dataset - res_ratio <- 3.333334 - # fullres should have a scalef of roughly 1. - # No way to guess hires or lowres scalefs so use arbitrary values. - hres_scalef <- switch(res_type, - "hires" = scalef, - "lowres" = scalef * res_ratio, - "fullres" = 0.08250825 # arbitrary - - ) - lres_scalef <- switch(res_type, - "hires" = scalef / res_ratio, - "lowres" = scalef, - "fullres" = 0.02475247 # arbitrary - ) -# spot diameter and fid diameter are variable based on how spatial info was -# mapped to the image. Estimate this by getting the center to center - # px distance vs fullsize px dims ratio. - # ! fullsize px dims is the same as edims ! - coords <- data.table::as.data.table(spatlocs) - # create a delaunay - dnet <- createNetwork( - as.matrix(coords[, c("sdimx", "sdimy")]), - type = "delaunay", - method = "geometry", - include_distance = TRUE, - as.igraph = FALSE, - include_weight = TRUE, - verbose = FALSE - ) - - # expect center to center be most common edge distance - # this gives CC dist as fullres px distance - distances <- sort(unique(dnet$distance)) - cc_px <- distances[which.max(table(dnet$distance))] - # assume constant ratios between diameters and cc_px - fid_cc_ratio <- 1.045909 -fid_diam <- cc_px * fid_cc_ratio -spot_cc_ratio <- 0.6474675 -spot_diam <- cc_px * spot_cc_ratio -scalef_list <- list( - spot = spot_diam, - fiducial = fid_diam, - hires = hres_scalef, - lowres = lres_scalef - ) -return(scalef_list) - - } + spatlocs) { + res_type <- match.arg(res_type, + choices = c("hires", "lowres", "fullres") + ) + pxdims <- dim(x)[1:2] + edims <- range(ext(x)) + scalef <- mean(pxdims / edims) + # assume that lowres and hires follow a general ratio + # may not be that important since the scalefactor should theoretically + # only matter for the image res that we are using + # this ratio is roughly 3.333334 based on Visium BreastCancerA1 dataset + res_ratio <- 3.333334 + # fullres should have a scalef of roughly 1. + # No way to guess hires or lowres scalefs so use arbitrary values. + hres_scalef <- switch(res_type, + "hires" = scalef, + "lowres" = scalef * res_ratio, + "fullres" = 0.08250825 # arbitrary + ) + lres_scalef <- switch(res_type, + "hires" = scalef / res_ratio, + "lowres" = scalef, + "fullres" = 0.02475247 # arbitrary + ) + # spot diameter and fid diameter are variable based on how spatial info was + # mapped to the image. Estimate this by getting the center to center + # px distance vs fullsize px dims ratio. + # ! fullsize px dims is the same as edims ! + coords <- data.table::as.data.table(spatlocs) + # create a delaunay + dnet <- createNetwork( + as.matrix(coords[, c("sdimx", "sdimy")]), + type = "delaunay", + method = "geometry", + include_distance = TRUE, + as.igraph = FALSE, + include_weight = TRUE, + verbose = FALSE + ) + + # expect center to center be most common edge distance + # this gives CC dist as fullres px distance + distances <- sort(unique(dnet$distance)) + cc_px <- distances[which.max(table(dnet$distance))] + # assume constant ratios between diameters and cc_px + fid_cc_ratio <- 1.045909 + fid_diam <- cc_px * fid_cc_ratio + spot_cc_ratio <- 0.6474675 + spot_diam <- cc_px * spot_cc_ratio + scalef_list <- list( + spot = spot_diam, + fiducial = fid_diam, + hires = hres_scalef, + lowres = lres_scalef + ) + return(scalef_list) +} #' @title Deprecated @@ -2139,19 +2159,14 @@ seuratToGiottoV4 <- function( } if (verbose) message("Copying nearest neighbour networks") - nnNetObj <- GiottoClass::createNearestNetObj( + nnNetObj <- createNearestNetObj( name = names(sobject@graphs)[i], network = sobjIgraph ) return(nnNetObj) }) - for (i in seq_along(nnNetObj_list)) { - gobject <- GiottoClass::set_NearestNetwork( - gobject = gobject, - nn_network = nnNetObj_list[[i]] - ) - } + gobject <- setGiotto(gobject, nnNetObj_list) } gobject <- createGiottoObject(exp, spatial_locs = spat_loc, @@ -2208,7 +2223,7 @@ seuratToGiottoV5 <- function( verbose = TRUE) { package_check("Seurat") - # NSE vars + # NSE vars sdimy <- NULL if (is.null(Seurat::GetAssayData( @@ -2249,12 +2264,16 @@ seuratToGiottoV5 <- function( # Cell Metadata cell_metadata <- sobject@meta.data cell_metadata <- data.table::as.data.table( - cell_metadata, keep.rownames = TRUE) + cell_metadata, + keep.rownames = TRUE + ) # Feat Metadata feat_metadata <- sobject[[]] feat_metadata <- data.table::as.data.table( - feat_metadata, keep.rownames = TRUE) + feat_metadata, + keep.rownames = TRUE + ) # rownames of both kept as `rn` # Dimension Reduction @@ -2310,11 +2329,13 @@ seuratToGiottoV5 <- function( assay = spatial_assay ))) { spat_coord <- Seurat::GetTissueCoordinates( - sobject, - scale = NULL, - cols = c( - "imagerow", - "imagecol")) + sobject, + scale = NULL, + cols = c( + "imagerow", + "imagecol" + ) + ) if (!("cell" %in% spat_coord)) { spat_coord$cell_ID <- rownames(spat_coord) @@ -2329,13 +2350,13 @@ seuratToGiottoV5 <- function( # flip them for Giotto spat_loc[, sdimy := -sdimy] data.table::setcolorder( - spat_loc, - neworder = c("sdimx", - "sdimy", - "cell_ID" - ) - ) - + spat_loc, + neworder = c( + "sdimx", + "sdimy", + "cell_ID" + ) + ) } else { message("Images for RNA assay not found in the data. Skipping image processing.") @@ -2344,15 +2365,18 @@ seuratToGiottoV5 <- function( } # Subcellular name <- names(sobject@images) - # if (!is.null(subcellular_assay)){ if (length(sobject@assays[[subcellular_assay]]) == 1) { - spat_coord <- Seurat::GetTissueCoordinates(sobject) - colnames(spat_coord) <- c("sdimx", "sdimy") - spat_coord$cell_ID <- rownames(spat_coord) - exp <- exp[, c(intersect(spat_coord$cell_ID, colnames(exp)))] - spat_loc <- spat_coord + if (!is.null(Seurat::Images( + object = sobject, + assay = spatial_assay + ))) { + spat_coord <- Seurat::GetTissueCoordinates(sobject) + colnames(spat_coord) <- c("sdimx", "sdimy") + spat_coord$cell_ID <- rownames(spat_coord) + exp <- exp[, c(intersect(spat_coord$cell_ID, colnames(exp)))] + spat_loc <- spat_coord + } } - # } if (!length(sobject@images) == 0) { for (i in names(sobject@images)) { if ("molecules" %in% names(sobject@images[[i]]) == TRUE) { @@ -2371,59 +2395,63 @@ seuratToGiottoV5 <- function( gpoints <- createGiottoPoints(mol_spatlocs, feat_type = "rna" ) - if ("centroids" %in% names(sobject@images[[i]])) { - centroids_coords <- - sobject@images[[i]]$centroids@coords - centroids_coords <- vect(centroids_coords) - gpolygon <- create_giotto_polygon_object( - name = "cell", spatVector = centroids_coords - ) - } - if ("segmentation" %in% names(sobject@images[[i]])) { - polygon_list <- list() - - for (j in seq(sobject@images[[ - i - ]]@boundaries$segmentation@polygons)) { - polygon_info <- sobject@images[[ - i - ]]@boundaries$segmentation@polygons[[j]] - - # Get coordinates from segmentation - seg_coords <- polygon_info@Polygons[[1]]@coords - - # Fetch cell_Id from polygon information - cell_ID <- polygon_info@ID - - # Convert it to SpatVector - seg_coords <- vect(seg_coords) - - # Create giotto_polygon_object - gpolygon <- create_giotto_polygon_object( - name = "cell", - spatVector = centroids_coords, - spatVectorCentroids = seg_coords - ) - - # Add the cell_ID to the list of polygon names - polygon_list[[cell_ID]] <- gpolygon - } - } } } + if ("centroids" %in% names(sobject@images[[i]])) { + centroids_coords <- + sobject@images[[i]]$centroids@coords + centroids_coords <- vect(centroids_coords) + gpolygon <- create_giotto_polygon_object( + name = "cell", spatVector = centroids_coords + ) + } + if ("segmentation" %in% names(sobject@images[[i]])) { + polygon_list <- list() + for (j in seq(sobject@images[[ + i + ]]@boundaries$segmentation@polygons)) { + polygon_info <- sobject@images[[ + i + ]]@boundaries$segmentation@polygons[[j]] + # Get coordinates from segmentation + + seg_coords <- polygon_info@Polygons[[1]]@coords + # Fetch cell_Id from polygon information + cell_ID <- polygon_info@ID + # Convert it to SpatVector + seg_coords <- vect(seg_coords) + # Create giotto_polygon_object + gpolygon <- create_giotto_polygon_object( + name = "cell", + spatVector = centroids_coords, + spatVectorCentroids = seg_coords + + ) + # Add the cell_ID to the list of polygon names + polygon_list[[cell_ID]] <- gpolygon + } + + } + } } } - + + + + + + + # Find SueratImages, extract them, and pass to create image image_list <- list() for (i in names(sobject@images)) { - simg <- sobject[[i]] + simg <- sobject[[i]] # check if image slot has image in it if ("image" %in% slotNames(simg)) { - img_array <- slot(simg, "image") - if (!is.null(img_array)) { - scalef <- Seurat::ScaleFactors(simg) + img_array <- slot(simg, "image") + if (!is.null(img_array)) { + scalef <- Seurat::ScaleFactors(simg) gImg <- createGiottoLargeImage( raster_object = terra::rast(img_array) * 255, name = i, @@ -2538,26 +2566,23 @@ seuratToGiottoV5 <- function( } if (verbose) message("Copying nearest neighbour networks") - nnNetObj <- GiottoClass::createNearestNetObj( + nnNetObj <- createNearestNetObj( name = names(sobject@graphs)[i], network = sobjIgraph ) return(nnNetObj) }) - for (i in seq_along(nnNetObj_list)) { - gobject <- GiottoClass::set_NearestNetwork( - gobject = gobject, - nn_network = nnNetObj_list[[i]] - ) - } + gobject <- setGiotto(gobject, nnNetObj_list) } gobject <- addCellMetadata( - gobject = gobject, new_metadata = cell_metadata, - by_column = TRUE, column_cell_ID = "rn") + gobject = gobject, new_metadata = cell_metadata, + by_column = TRUE, column_cell_ID = "rn" + ) gobject <- addFeatMetadata( - gobject = gobject, new_metadata = feat_metadata) + gobject = gobject, new_metadata = feat_metadata + ) if (exists("gpoints")) { gobject <- addGiottoPoints( @@ -2744,7 +2769,6 @@ giottoToSpatialExperiment <- function(giottoObj, verbose = TRUE) { spatialLocs <- spatialLocs[, c("sdimx", "sdimy"), drop = FALSE] } SpatialExperiment::spatialCoords(spe) <- data.matrix(spatialLocs) - } else { if (verbose) { message("No spatial locations found in the input Giotto object") @@ -2935,7 +2959,6 @@ giottoToSpatialExperiment <- function(giottoObj, verbose = TRUE) { #' networks. This can be a vector of multiple network names. #' @param verbose A boolean value specifying if progress messages should #' be displayed or not. Default \code{TRUE}. -#' @import data.table #' @returns Giotto object #' @examples #' \dontrun{ @@ -3389,7 +3412,7 @@ giottoMasterToSuite <- function( #' 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 +#' @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. @@ -3397,7 +3420,7 @@ giottoMasterToSuite <- function( #' 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, +#' @param delaunay_spat_net binary parameter for spatial network. If TRUE, #' the spatial network is a delaunay network. #' @param spat_unit desired spatial unit for conversion, default NULL #' @param feat_type desired feature type for conversion, default NULL @@ -3420,7 +3443,6 @@ spatialdataToGiotto <- function( feat_type = NULL, python_path = NULL, env_name = NULL) { - # File check if (is.null(spatialdata_path)) { stop("Please provide a path to SpatialData object for conversion.\n") @@ -3485,9 +3507,12 @@ spatialdataToGiotto <- function( ) # Attach hires image - raster <- terra::rast(extract_image(sdata)) - giotto_image <- createGiottoLargeImage(raster) - gobject <- addGiottoLargeImage(gobject = gobject, largeImages = c(giotto_image)) + extracted_images <- extract_image(sdata) + extract_image_names <- extract_image_names(sdata) + + raster_image_list <- lapply(extracted_images, terra::rast) + large_image_list <- createGiottoLargeImageList(raster_image_list, names = extract_image_names) + gobject <- addGiottoLargeImage(gobject = gobject, largeImages = large_image_list) # Attach metadata cm <- readCellMetadata(cm) @@ -3593,7 +3618,7 @@ spatialdataToGiotto <- function( 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)], directed = TRUE, vertices = vert) - nn_info <- extract_NN_info(adata = adata, key_added = n_key_added_it) + nn_info <- extract_NN_info(sdata = sdata, key_added = n_key_added_it) net_type <- "kNN" # anndata default if (("sNN" %in% n_key_added_it) & !is.null(n_key_added_it)) { @@ -3717,6 +3742,35 @@ spatialdataToGiotto <- function( ) } } + + ### Layers + lay_names <- extract_layer_names(sdata) + if (!is.null(lay_names)) { + for (l_n in lay_names) { + lay <- extract_layered_data(sdata, layer_name = l_n) + if ("data.frame" %in% class(lay)) { + names(lay) <- fID + row.names(lay) <- cID + } else { + lay@Dimnames[[1]] <- fID + lay@Dimnames[[2]] <- cID + } + layExprObj <- createExprObj(lay, name = l_n) + gobject <- set_expression_values( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + name = l_n, + values = layExprObj + ) + } + } + + gobject <- update_giotto_params( + gobject = gobject, + description = "_AnnData_Conversion" + ) + return(gobject) } @@ -3748,7 +3802,6 @@ giottoToSpatialData <- function( python_path = NULL, env_name = NULL, save_directory = NULL) { - # Initialize reticulate instrs <- createGiottoInstructions(python_path = python_path) @@ -3779,32 +3832,34 @@ giottoToSpatialData <- function( save_directory = temp ) - # Extract GiottoImage - gimg <- getGiottoImage(gobject, image_type = "largeImage") - - # Temporarily save the image to disk - writeGiottoLargeImage( - giottoLargeImage = gimg, - gobject = gobject, - largeImage_name = "largeImage", - filename = "temp_image.png", - dataType = NULL, - max_intensity = NULL, - overwrite = TRUE, - verbose = TRUE - ) + # Extract GiottoImage only if an image exists + image_exists <- NULL + if (length(slot(gobject, "images")) > 0) { + image_exists <- TRUE + gimg_list <- slot(gobject, "images") + for (i in seq_along(gimg_list)) { + img_name <- slot(gimg_list[[i]], "name") + writeGiottoLargeImage( + giottoLargeImage = gimg_list[[i]], + gobject = gobject, + largeImage_name = img_name, + filename = paste0(temp, img_name, ".png"), + dataType = NULL, + max_intensity = NULL, + overwrite = TRUE, + verbose = TRUE + ) + } + } - spat_locs <- getSpatialLocations(gobject, output="data.table") + spat_locs <- getSpatialLocations(gobject, output = "data.table") # Create SpatialData object - createSpatialData(temp, spat_locs, spot_radius, save_directory) + createSpatialData(temp, spat_locs, spot_radius, save_directory, image_exists) # Delete temporary files and folders - unlink("temp_image.png") - unlink("temp_image.png.aux.xml") unlink(temp, recursive = TRUE) # Successful Conversion cat("Giotto object has been converted and saved to SpatialData object at: ", save_directory, "\n") - } diff --git a/R/join.R b/R/join.R index 5dcd4674..a74ddc26 100644 --- a/R/join.R +++ b/R/join.R @@ -4,19 +4,16 @@ #' @name .join_expression_matrices #' @keywords internal #' @noRd -.join_expression_matrices <- function(matrix_list) { +.join_expression_matrices <- function(matrix_list, feat_ids = NULL) { # find all features - final_feats <- list() - for (matr_i in seq_len(length(matrix_list))) { - rowfeats <- rownames(matrix_list[[matr_i]]) - final_feats[[matr_i]] <- rowfeats + if (is.null(feat_ids)) { + final_feats <- lapply(matrix_list, rownames) + final_feats <- unique(unlist(final_feats)) + } else { + final_feats <- feat_ids } - - final_feats <- unique(unlist(final_feats)) final_feats <- mixedsort(final_feats) - - # extend matrices with missing ids final_mats <- list() for (matr_i in seq_len(length(matrix_list))) { @@ -52,18 +49,28 @@ #' @name .join_cell_meta #' @keywords internal #' @noRd -.join_cell_meta <- function(dt_list) { - final_list <- do.call("rbind", dt_list) - return(final_list) +.join_cell_meta <- function(obj_list) { + do.call("rbind", obj_list) } #' @title .join_feat_meta #' @name .join_feat_meta #' @keywords internal #' @noRd -.join_feat_meta <- function(dt_list) { +.join_feat_meta <- function(dt_list, feat_ids = NULL) { feat_ID <- NULL + if (!is.null(feat_ids)) { + dt_list <- lapply(dt_list, function(dt) { + dt <- dt[feat_ID %in% feat_ids] + missing_feat <- dt[, feat_ids[!feat_ids %in% feat_ID]] + if (length(missing_feat) > 0L) { + dt_append <- data.table::data.table(feat_ID = missing_feat) + dt <- rbind(dt, dt_append, fill = TRUE) + } + }) + } + comb_meta <- do.call("rbind", c(dt_list, fill = TRUE)) comb_meta <- unique(comb_meta) @@ -78,9 +85,13 @@ "feature metadata: multiple versions of metadata for:\n", dup_feats, "\n First entry will be selected for joined object." + # "first" is based on gobject order )) } + # order by feat_ID + comb_meta <- comb_meta[mixedorder(feat_ID)] + return(comb_meta) } @@ -109,11 +120,11 @@ #' multiple giotto objects into a single one. Giotto supports multiple ways of #' joining spatial information as selected through param `join_method`: #' -#' * **"shift"** +#' * **"shift"** #' (default) Spatial locations of different datasets are shifted #' by numeric vectors of values supplied through `x_shift`, -#' `y_shift`, `x_padding`, and `y_padding`. This is particularly useful -#' for data that is provided as tiles or ROIs or when analyzing multiple +#' `y_shift`, `x_padding`, and `y_padding`. This is particularly useful +#' for data that is provided as tiles or ROIs or when analyzing multiple #' spatial datasets together and keeping their spatial data separate. #' #' **If shift values are given then a value is needed for each giotto @@ -123,8 +134,8 @@ #' use `x_padding` and `y_padding`. Both shift and padding values #' can be used at the same time. #' -#' When `x_shift` is `NULL`, it defaults to the x range of gobjects in the -#' list so that datasets are xshifted exactly next to each other with no +#' When `x_shift` is `NULL`, it defaults to the x range of gobjects in the +#' list so that datasets are xshifted exactly next to each other with no #' overlaps. An additional default `x_padding = 1000` is applied if #' `x_shift`, `x_padding`, `y_shift`, `y_padding` are all `NULL`. #' * **"z_stack"** @@ -153,10 +164,10 @@ #' g2 <- createGiottoObject(expression = m2) #' #' joinGiottoObjects( -#' gobject_list = list(g1, g2), +#' gobject_list = list(g1, g2), #' gobject_names = c("g1", "g2") #' ) -#' +#' #' # dry run joining objects with spatial information #' # a default x_padding of 1000 is applied #' viz <- GiottoData::loadGiottoMini("viz") @@ -165,9 +176,9 @@ #' gobject_names = c("v1", "v2"), #' dry_run = TRUE #' ) -#' +#' #' # place them right next to each other -#' # note that this means generated spatial networks will be more likely to +#' # note that this means generated spatial networks will be more likely to #' # link across the datasets #' joinGiottoObjects( #' list(viz, viz), @@ -175,24 +186,25 @@ #' dry_run = TRUE, #' x_padding = 0 #' ) -#' +#' #' # join the spatial objects #' joined_viz <- joinGiottoObjects( #' list(viz, viz), #' gobject_names = c("v1", "v2") #' ) -#' +#' #' @export -joinGiottoObjects <- function(gobject_list, - gobject_names = NULL, - join_method = c("shift", "z_stack", "no_change"), - z_vals = 1000, - x_shift = NULL, - y_shift = NULL, - x_padding = NULL, - y_padding = NULL, - dry_run = FALSE, - verbose = FALSE) { +joinGiottoObjects <- function( + gobject_list, + gobject_names = NULL, + join_method = c("shift", "z_stack", "no_change"), + z_vals = 1000, + x_shift = NULL, + y_shift = NULL, + x_padding = NULL, + y_padding = NULL, + dry_run = FALSE, + verbose = FALSE) { # NSE vars sdimz <- cell_ID <- sdimx <- sdimy <- name <- NULL @@ -255,10 +267,12 @@ joinGiottoObjects <- function(gobject_list, # Set default x_padding = 1000 if no shift params are given if (is.null(x_shift) && is.null(y_shift) && is.null(x_padding) && is.null(y_padding)) { - vmsg(.v = verbose, - "No xy shift or specific padding values given. + vmsg( + .v = verbose, + "No xy shift or specific padding values given. Using defaults: x_padding = 1000 - Set any padding value of 0 to avoid this behavior") + Set any padding value of 0 to avoid this behavior" + ) x_padding <- 1000 } # Assign default padding values if NULL @@ -274,7 +288,8 @@ joinGiottoObjects <- function(gobject_list, if (is.null(x_shift)) { # if no x_shift provide default x_shift as object ext x range x_shift <- vapply( - gobj_idx, FUN.VALUE = numeric(length = 1L), + gobj_idx, + FUN.VALUE = numeric(length = 1L), function(g_i) { range(gext[[g_i]])[["x"]] } @@ -340,7 +355,8 @@ joinGiottoObjects <- function(gobject_list, gp <- terra::as.polygons(gext[[ge_i]]) # perform transforms gp <- terra::shift( - gp, dx = final_x_shift[[ge_i]], dy = final_y_shift[[ge_i]] + gp, + dx = final_x_shift[[ge_i]], dy = final_y_shift[[ge_i]] ) return(gp) }) @@ -475,7 +491,8 @@ joinGiottoObjects <- function(gobject_list, # get all spatLocsObj in the gobj available_locs <- getSpatialLocations( - gobj, spat_unit = ":all:", name = ":all:", output = "spatLocsObj", + gobj, + spat_unit = ":all:", name = ":all:", output = "spatLocsObj", copy_obj = TRUE, verbose = FALSE, set_defaults = FALSE, simplify = FALSE ) @@ -497,7 +514,8 @@ joinGiottoObjects <- function(gobject_list, ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### gobj <- setGiotto( - gobj, available_locs, verbose = FALSE, initialize = FALSE + gobj, available_locs, + verbose = FALSE, initialize = FALSE ) ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### @@ -511,12 +529,19 @@ joinGiottoObjects <- function(gobject_list, # update IDs for (spat_unit in names(gobj@cell_metadata)) { for (feat_type in names(gobj@cell_metadata[[spat_unit]])) { - gobj@cell_metadata[[spat_unit]][[feat_type]]@metaDT[[ - "cell_ID" - ]] <- gobj@cell_ID[[spat_unit]] - gobj@cell_metadata[[spat_unit]][[feat_type]]@metaDT[[ - "list_ID" - ]] <- gname + cx <- getCellMetadata(gobj, + spat_unit = spat_unit, + feat_type = feat_type, + output = "cellMetaObj", + copy_obj = TRUE, + set_defaults = FALSE + ) + + cx[][["list_ID"]] <- gname + cx[][["cell_ID"]] <- paste0(gname, "-", cx[][["cell_ID"]]) + gobj <- setGiotto(gobj, cx, + initialize = FALSE, verbose = FALSE + ) } } @@ -567,7 +592,6 @@ joinGiottoObjects <- function(gobject_list, # networks?? # TODO - } @@ -614,36 +638,10 @@ joinGiottoObjects <- function(gobject_list, ## expression and feat IDs - ## if no expression matrices are provided, then just combine all feature IDs vmsg(.v = verbose, "2. expression data") - avail_expr <- list_expression(gobject = first_obj) - if (is.null(avail_expr)) { - ## feat IDS - for (feat in first_features) { - combined_feat_ID <- unique(unlist(all_feat_ID_list[[feat]])) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - comb_gobject <- set_feat_id( - gobject = comb_gobject, - feat_type = feat, - feat_IDs = combined_feat_ID, - set_defaults = FALSE - ) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - } - - # Moved de novo feature metadata generation as a catch to the end of - # the fxn. Done through init_feat_meta() - - # S4_feat_metadata = create_feat_meta_obj(spat_unit = spat_unit, - # feat_type = feat_type, - # metaDT = data.table::data.table(feat_ID = combined_feat_ID)) - - # comb_gobject = setFeatureMetadata(gobject = comb_gobject, - # S4_feat_metadata, - # initialize = FALSE) - } else { + if (!is.null(avail_expr)) { for (exprObj_i in seq(nrow(avail_expr))) { expr_list <- lapply(updated_object_list, function(gobj) { getExpression( @@ -671,13 +669,6 @@ joinGiottoObjects <- function(gobject_list, values = expr_list[[1]], set_defaults = FALSE ) - - comb_gobject <- set_feat_id( - gobject = comb_gobject, - feat_type = avail_expr$feat_type[[exprObj_i]], - feat_IDs = combmat[["sort_all_feats"]], - set_defaults = FALSE - ) ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### # Moved de novo feat metadata generation to end of fxn as a catch @@ -685,10 +676,91 @@ joinGiottoObjects <- function(gobject_list, } + ## spatial info + vmsg(.v = verbose, "3. spatial polygon information") + + available_spat_info <- unique(unlist(all_spatinfo_list)) + + if (isTRUE(verbose)) { + wrap_msg("available_spat_info: \n") + wrap_msg(available_spat_info) + } + + for (spat_info in available_spat_info) { + savelist_vector <- list() + savelist_centroids <- list() + for (gobj_i in seq_along(updated_object_list)) { + gpoly <- getPolygonInfo( + updated_object_list[[gobj_i]], + return_giottoPolygon = TRUE + ) + spat_information_vector <- gpoly[] + spat_information_centroids <- centroids(gpoly) + + savelist_vector[[gobj_i]] <- spat_information_vector + savelist_centroids[[gobj_i]] <- spat_information_centroids + + # TODO: add overlaps + } + + + + comb_spatvectors <- do.call("rbind", savelist_vector) + comb_spatcentroids <- do.call("rbind", savelist_centroids) + + comb_polygon <- create_giotto_polygon_object( + name = spat_info, + spatVector = comb_spatvectors, + spatVectorCentroids = comb_spatcentroids, + overlaps = NULL + ) + + + comb_gobject@spatial_info[[spat_info]] <- comb_polygon + } + + + + ## feature info + vmsg(.v = verbose, "4. spatial feature/points information") + + + for (feat in first_features) { + savelist_vector <- list() + + for (gobj_i in seq_along(updated_object_list)) { + updated_feat_info <- + updated_object_list[[gobj_i]]@feat_info[[feat]] + + if (!is.null(updated_feat_info)) { + spat_point_vector <- updated_feat_info@spatVector + } else { + spat_point_vector <- NULL + } + + savelist_vector[[gobj_i]] <- spat_point_vector + + # TODO: add network + } + + comb_spatvectors <- do.call("rbind", savelist_vector) + + if (is.null(comb_spatvectors)) { + comb_points <- NULL + } else { + comb_points <- create_giotto_points_object( + feat_type = feat, + spatVector = comb_spatvectors, + networks = NULL + ) + } + + comb_gobject@feat_info[[feat]] <- comb_points + } ## spatial locations - vmsg(.v = verbose, "3. spatial locations") + vmsg(.v = verbose, "5. spatial locations") available_locs <- list_spatial_locations(first_obj) @@ -711,7 +783,8 @@ joinGiottoObjects <- function(gobject_list, ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### comb_gobject <- setGiotto( - comb_gobject, combspatlocs, initialize = FALSE, verbose = FALSE + comb_gobject, combspatlocs, + initialize = FALSE, verbose = FALSE ) ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### } @@ -721,7 +794,7 @@ joinGiottoObjects <- function(gobject_list, ## cell metadata - vmsg(.v = verbose, "4. cell metadata") + vmsg(.v = verbose, "6. cell metadata") for (spat_unit in names(first_obj@cell_metadata)) { for (feat_type in names(first_obj@cell_metadata[[spat_unit]])) { @@ -729,27 +802,14 @@ joinGiottoObjects <- function(gobject_list, for (gobj_i in seq_along(updated_object_list)) { cellmeta <- updated_object_list[[ gobj_i - ]]@cell_metadata[[spat_unit]][[feat_type]][] + ]]@cell_metadata[[spat_unit]][[feat_type]] savelist[[gobj_i]] <- cellmeta } - combcellmeta <- .join_cell_meta(dt_list = savelist) - - S4_cell_meta <- getCellMetadata( - gobject = first_obj, - spat_unit = spat_unit, - feat_type = feat_type, - copy_obj = TRUE, - set_defaults = FALSE, - output = "cellMetaObj" - ) - S4_cell_meta[] <- combcellmeta + combcellmeta <- .join_cell_meta(obj_list = savelist) ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - comb_gobject <- setCellMetadata( - gobject = comb_gobject, - x = S4_cell_meta, - initialize = FALSE, - verbose = FALSE + comb_gobject <- setGiotto(comb_gobject, combcellmeta, + verbose = FALSE, initialize = FALSE ) ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### } @@ -798,87 +858,7 @@ joinGiottoObjects <- function(gobject_list, - ## spatial info - vmsg(.v = verbose, "5. spatial polygon information") - - available_spat_info <- unique(unlist(all_spatinfo_list)) - - if (isTRUE(verbose)) { - wrap_msg("available_spat_info: \n") - wrap_msg(available_spat_info) - } - for (spat_info in available_spat_info) { - savelist_vector <- list() - savelist_centroids <- list() - for (gobj_i in seq_along(updated_object_list)) { - spat_information_vector <- updated_object_list[[ - gobj_i - ]]@spatial_info[[spat_info]]@spatVector - savelist_vector[[gobj_i]] <- spat_information_vector - - spat_information_centroids <- updated_object_list[[ - gobj_i - ]]@spatial_info[[spat_info]]@spatVectorCentroids - savelist_centroids[[gobj_i]] <- spat_information_centroids - - # TODO: add overlaps - } - - - - comb_spatvectors <- do.call("rbind", savelist_vector) - comb_spatcentroids <- do.call("rbind", savelist_centroids) - - comb_polygon <- create_giotto_polygon_object( - name = spat_info, - spatVector = comb_spatvectors, - spatVectorCentroids = comb_spatcentroids, - overlaps = NULL - ) - - - comb_gobject@spatial_info[[spat_info]] <- comb_polygon - } - - - - ## feature info - vmsg(.v = verbose, "6. spatial feature/points information") - - - for (feat in first_features) { - # for(feat in comb_gobject@expression_feat) { - - savelist_vector <- list() - - for (gobj_i in seq_along(updated_object_list)) { - if (is.null(updated_object_list[[gobj_i]]@feat_info)) { - spat_point_vector <- NULL - } else { - spat_point_vector <- - updated_object_list[[gobj_i]]@feat_info[[feat]]@spatVector - } - - savelist_vector[[gobj_i]] <- spat_point_vector - - # TODO: add network - } - - comb_spatvectors <- do.call("rbind", savelist_vector) - - if (is.null(comb_spatvectors)) { - comb_points <- NULL - } else { - comb_points <- create_giotto_points_object( - feat_type = feat, - spatVector = comb_spatvectors, - networks = NULL - ) - } - - comb_gobject@feat_info[[feat]] <- comb_points - } ## If no feature_metadata exists, then generate now @@ -933,5 +913,3 @@ joinGiottoObjects <- function(gobject_list, x[][, "cell_ID" := as.character(ids)] return(x) } - - diff --git a/R/methods-IDs.R b/R/methods-IDs.R index 7c8f796b..a3726984 100644 --- a/R/methods-IDs.R +++ b/R/methods-IDs.R @@ -24,13 +24,30 @@ NULL #' #' @aliases spatIDs featIDs #' @param x an object -#' @param ... additional parameters to pass -#' @returns spatIDs and featIDs +#' @param subset logical expression to find a subset of features. +#' @param negate logical. if `TRUE` all IDs that are **not** in the `subset` +#' are selected +#' @param quote logical. If `TRUE`, the `subset` param will be quoted with +#' `substitute()`. Set this to `FALSE` when calling from a function, although +#' that may not be recommended since NSE output can be unexpected when not used +#' interactively. +#' @param \dots additional params to pass when used with the `subset` param. +#' For `spatID()`, these pass to [spatValues()]. For `featID()`, these +#' currently only pass to `fDataDT()`. +#' @returns character vector of cell/spatial IDs or feature IDs #' @include classes.R #' @examples -#' g <- GiottoData::loadSubObjectMini("giottoPoints") +#' g <- GiottoData::loadGiottoMini("vis") +#' spatIDs(g) +#' spatIDs(g, subset = nr_feats <= 200) +#' spatIDs(g, subset = Dim.1 > 25, dim_reduction_to_use = "umap") #' #' featIDs(g) +#' featIDs(g, subset = nr_cells < 100) +#' +#' gpoints <- GiottoData::loadSubObjectMini("giottoPoints") +#' featIDs(gpoints) +#' NULL @@ -44,8 +61,37 @@ NULL #' @export setMethod( "spatIDs", signature(x = "giotto"), - function(x, spat_unit = NULL, ...) { - as.character(get_cell_id(gobject = x, spat_unit, ...)) + function(x, spat_unit = NULL, subset, negate = FALSE, quote = TRUE, ...) { + if (missing(subset)) { + res <- as.character(get_cell_id(gobject = x, spat_unit, ...)) + return(res) + } + + if (quote) { + sub_s <- substitute(subset) + } else { + sub_s <- subset + } + if (negate) sub_s <- call("!", sub_s) + vars <- all.vars(sub_s) + vals <- lapply(vars, function(v) { + spatValues(x, + feats = v, + spat_unit = spat_unit, + verbose = FALSE, + ... + ) + }) + .dtjoin <- function(x, y) { + x[y, on = "cell_ID"] + } + vals_dt <- Reduce(.dtjoin, vals) + if (identical(getOption("giotto.verbose"), "debug")) { + message("data.table used in subset") + print(vals_dt) + } + sids <- subset.data.frame(vals_dt, subset = eval(sub_s))$cell_ID + return(sids) } ) #' @rdname spatIDs-generic @@ -138,8 +184,20 @@ setMethod( #' @export setMethod( "featIDs", signature(x = "giotto"), - function(x, feat_type = NULL, ...) { - as.character(get_feat_id(gobject = x, feat_type, ...)) + function(x, feat_type = NULL, subset, negate = FALSE, quote = TRUE, ...) { + if (missing(subset)) { + res <- as.character(get_feat_id(gobject = x, feat_type, ...)) + return(res) + } + if (quote) { + sub_s <- substitute(subset) + } else { + sub_s <- subset + } + if (negate) sub_s <- call("!", sub_s) + fx <- fDataDT(x, feat_type = feat_type, ...) + fids <- subset.data.frame(fx, subset = eval(sub_s))$feat_ID + return(fids) } ) #' @rdname spatIDs-generic diff --git a/R/methods-XY.R b/R/methods-XY.R new file mode 100644 index 00000000..3c7992ba --- /dev/null +++ b/R/methods-XY.R @@ -0,0 +1,147 @@ +# docs ----------------------------------------------------------- # +#' @title Spatial coordinates +#' @name XY +#' @aliases XY<- +#' @description Directly get and set the xy(z) coordinates of spatial +#' subobjects (currently `spatLocsObj`, `giottoPoints`, `giottoPolygon`). +#' coordinate values are retrieved and set as `matrix`. +#' @param x object +#' @param value matrix. xy(z) coordinates to set +#' @param ... additional args to pass +#' @returns `XY()` returns `matrix`. `XY<-()` returns same class as `x` +#' @examples +#' sl <- GiottoData::loadSubObjectMini("spatLocsObj") +#' gpoly <- GiottoData::loadSubObjectMini("giottoPolygon") +#' gpoints <- GiottoData::loadSubObjectMini("giottoPoints") +#' +#' m1 <- XY(sl) +#' plot(sl) +#' XY(sl) <- m1 + 1000 +#' plot(sl) +#' +#' m2 <- XY(gpoints) +#' plot(gpoints) +#' XY(gpoints) <- m2 * 2 + 1000 +#' plot(gpoints) +#' +#' m3 <- XY(gpoly) +#' plot(gpoly) +#' XY(gpoly) <- m3 / 2 +#' plot(gpoly) +#' +#' XY(gpoly[1:10]) # vertices from first 10 polys +NULL +# ---------------------------------------------------------------- # + + + +# * spatLocsObj #### + +#' @rdname XY +#' @export +setMethod("XY", signature("spatLocsObj"), function(x, ...) { + m <- x[][, colnames(x) != "cell_ID", with = F] |> + as.matrix(...) + if (ncol(m) == 2L) colnames(m) <- c("x", "y") + if (ncol(m) == 3L) colnames(m) <- c("x", "y", "z") + return(m) +}) + +#' @rdname XY +#' @export +setMethod( + "XY<-", signature(x = "spatLocsObj", value = "matrix"), + function(x, value) { + dt <- data.table::as.data.table(value) + if (ncol(dt) == 2L) { + data.table::setnames(dt, new = c("sdimx", "sdimy")) + } + if (ncol(dt) == 3L) { + data.table::setnames(dt, new = c("sdimx", "sdimy", "sdimx")) + } + x[] <- cbind(dt, x[][, "cell_ID"]) + return(x) + } +) + +# * giottoPoints & giottoPolygon #### + +#' @rdname XY +#' @export +setMethod("XY", signature("giottoPoints"), function(x, ...) { + return(XY(x[], ...)) +}) + +#' @rdname XY +#' @export +setMethod( + "XY<-", signature(x = "giottoPoints", value = "ANY"), + function(x, ..., value) { + XY(x[]) <- value + return(x) + } +) + +#' @rdname XY +#' @export +setMethod("XY", signature("giottoPolygon"), function(x, ...) { + return(XY(x[], ...)) +}) + +#' @rdname XY +#' @export +setMethod( + "XY<-", signature(x = "giottoPolygon", value = "ANY"), + function(x, ..., value) { + XY(x[]) <- value + return(x) + } +) + +# * SpatVector #### + +#' @rdname XY +#' @param include_geom logical. Whether `geom`, `part`, and `hole` from the +#' terra geometry matrix should be included. +#' @export +setMethod("XY", signature("SpatVector"), function(x, include_geom = FALSE, ...) { + m <- terra::geom(x, ...) + if (!include_geom) { + m <- m[, c("x", "y")] + } + return(m) +}) + +#' @rdname XY +#' @export +setMethod("XY<-", signature(x = "SpatVector", value = "matrix"), function(x, ..., value) { + switch(terra::geomtype(x), + "points" = .xy_sv_points_set(x, ..., value = value), + "polygons" = .xy_sv_polys_set(x, ..., value = value) + ) +}) + + + +# internals #### + + +.xy_sv_points_set <- function(x, ..., value) { + atts <- terra::values(x) + v <- terra::vect(value, type = "points", ..., atts = atts) + return(v) +} + +.xy_sv_polys_set <- function(x, ..., value) { + atts <- terra::values(x) + if (identical(colnames(x), c("geom", "part", "x", "y", "hole"))) { + # the entire geom matrix is given. Directly use it. + v <- terra::vect(value, type = "polygons", ..., atts = atts) + } else { + # replace xy values in geom matrix + m <- terra::geom(x) + m[, "x"] <- value[, "x"] + m[, "y"] <- value[, "y"] + v <- terra::vect(m, type = "polygons", ..., atts = atts) + } +} diff --git a/R/methods-affine.R b/R/methods-affine.R index f4bfaebe..5ca83ac7 100644 --- a/R/methods-affine.R +++ b/R/methods-affine.R @@ -19,11 +19,11 @@ #' trans_m <- matrix(c(1, 0, 0, 0, 1, 0, 200, 300, 1), nrow = 3) #' scale_m <- matrix(c(2, 0, 0, 0, 3, 0, 0, 0, 1), nrow = 3) #' aff_m <- matrix(c(2, 3, 0, 0.2, 3, 0, 100, 29, 1), nrow = 3) -#' +#' #' gpoints <- GiottoData::loadSubObjectMini("giottoPoints") #' gpoly <- GiottoData::loadSubObjectMini("giottoPolygon") #' sl <- GiottoData::loadSubObjectMini("spatLocsObj") -#' +#' #' # creation of affine2d #' aff <- affine(m) #' aff <- spin(flip(shear(aff, fx = 0.2)), 45) @@ -32,7 +32,7 @@ #' # giottoPoints ############################################## #' plot(gpoints) #' plot(affine(gpoints, trans_m)) -#' +#' #' # giottoPolygon ############################################# #' plot(gpoly) #' plot(affine(gpoly, scale_m)) @@ -59,23 +59,21 @@ NULL #' to affect all can be used. #' @export setMethod( - "affine", signature(x = "giotto", y = "matrix"), function( - x, y, inv = FALSE, - spat_unit = ":all:", feat_type = ":all:", images = ":all:", - ... - ) { + "affine", signature(x = "giotto", y = "matrix"), function(x, y, inv = FALSE, + spat_unit = ":all:", feat_type = ":all:", images = ":all:", + ...) { a <- list(y = y, inv = inv, ...) - + spat_unit <- set_default_spat_unit( gobject = x, spat_unit = spat_unit ) feat_type <- set_default_feat_type( gobject = x, spat_unit = spat_unit, feat_type = feat_type ) - + all_su <- spat_unit == ":all:" all_ft <- feat_type == ":all:" - + # polygons --------------------------------------------------------- # polys <- get_polygon_info_list( gobject = x, return_giottoPolygon = TRUE @@ -84,12 +82,12 @@ setMethod( polys <- polys[spatUnit(polys) %in% spat_unit] } if (!is.null(polys)) { - for(poly in polys) { + for (poly in polys) { poly <- do.call(affine, args = c(list(x = poly), a)) x <- setGiotto(x, poly, verbose = FALSE, initialize = FALSE) } } - + # spatlocs --------------------------------------------------------- # sls <- get_spatial_locations_list( gobject = x, @@ -105,7 +103,7 @@ setMethod( sl <- do.call(affine, args = c(list(x = sl), a)) x <- setGiotto(x, sl, verbose = FALSE, initialize = FALSE) } - + # TODO remove this after spatial info is removed from # spatialNetwork objs sn_list <- get_spatial_network_list( @@ -120,9 +118,9 @@ setMethod( regenerated"), call. = FALSE) } } - + # points ----------------------------------------------------------- # - + pts <- get_feature_info_list( gobject = x, return_giottoPoints = TRUE ) @@ -130,13 +128,13 @@ setMethod( pts <- pts[featType(pts) %in% feat_type] } if (!is.null(pts)) { - for(pt in pts) { + for (pt in pts) { pt <- do.call(affine, args = c(list(x = pt), a)) x <- setGiotto(x, pt, verbose = FALSE, initialize = FALSE) } } # images ----------------------------------------------------------- # - + imgs <- get_giotto_image_list(x) if (!is.null(imgs)) { if (!inherits(imgs, "list")) imgs <- list(imgs) @@ -145,7 +143,7 @@ setMethod( x <- setGiotto(x, img, verbose = FALSE) } } - + return(initialize(x)) # init not necessarily needed } ) @@ -181,10 +179,12 @@ setMethod("affine", signature(x = "ANY", y = "affine2d"), function(x, y, ...) { # * SpatVector, matrix #### #' @rdname affine #' @export -setMethod("affine", signature(x = "SpatVector", y = "matrix"), - function(x, y, inv = FALSE, ...) { - .affine_sv(x, m = y, inv, ...) -}) +setMethod( + "affine", signature(x = "SpatVector", y = "matrix"), + function(x, y, inv = FALSE, ...) { + .affine_sv(x, m = y, inv, ...) + } +) # * giottoPoints, matrix #### #' @rdname affine @@ -223,9 +223,7 @@ setMethod( # * giottoLargeImage, matrix #### #' @rdname affine #' @export -setMethod("affine", signature(x = "giottoLargeImage", y = "matrix"), function( - x, y, inv = FALSE, ... -) { +setMethod("affine", signature(x = "giottoLargeImage", y = "matrix"), function(x, y, inv = FALSE, ...) { a <- get_args_list(...) a$x <- as(x, "giottoAffineImage") # convert to giottoAffineImage res <- do.call(affine, args = a) @@ -235,9 +233,7 @@ setMethod("affine", signature(x = "giottoLargeImage", y = "matrix"), function( # * giottoAffineImage, matrix #### #' @rdname affine #' @export -setMethod("affine", signature(x = "giottoAffineImage", y = "matrix"), function( - x, y, inv = FALSE, ... -) { +setMethod("affine", signature(x = "giottoAffineImage", y = "matrix"), function(x, y, inv = FALSE, ...) { a <- get_args_list(...) aff <- x@affine a$x <- aff @@ -249,16 +245,14 @@ setMethod("affine", signature(x = "giottoAffineImage", y = "matrix"), function( # * affine2d, matrix #### #' @rdname affine #' @export -setMethod("affine", signature(x = "affine2d", y = "matrix"), function( - x, y, inv = FALSE, ... -) { +setMethod("affine", signature(x = "affine2d", y = "matrix"), function(x, y, inv = FALSE, ...) { a <- get_args_list() # update linear m <- .aff_linear_2d(y) if (isTRUE(inv)) m <- solve(m) old_aff <- new_aff <- x@affine .aff_linear_2d(new_aff) <- .aff_linear_2d(new_aff) %*% m - + ## calc shifts ## # create dummy d <- .bound_poly(x@anchor) @@ -266,18 +260,18 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( a$x <- affine(d, old_aff) # perform new transform post <- do.call(affine, args = a) - + # perform affine & transform without shifts b <- a b$y <- .aff_linear_2d(y) b$x <- affine(d, .aff_linear_2d(old_aff)) pre <- do.call(affine, args = b) - + # find xyshift by comparing tfs so far vs new tf xyshift <- .get_centroid_xy(post) - .get_centroid_xy(pre) - + # update translate - .aff_shift_2d(new_aff) <- xyshift + .aff_shift_2d(new_aff) <- xyshift x@affine <- new_aff return(initialize(x)) @@ -294,22 +288,20 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( xdt <- .affine_dt( x = xdt, m = m, xcol = "x", ycol = "y", inv = inv, ... ) - + res <- switch(gtype, - "points" = terra::vect(xdt, geom = c("x", "y")), - "polygons" = terra::as.polygons(xdt) + "points" = terra::vect(xdt, geom = c("x", "y")), + "polygons" = terra::as.polygons(xdt) ) - + return(res) } -.affine_dt <- function( - x, m, xcol = "sdimx", ycol = "sdimy", inv = FALSE, ... -) { +.affine_dt <- function(x, m, xcol = "sdimx", ycol = "sdimy", inv = FALSE, ...) { x <- data.table::as.data.table(x) m <- as.matrix(m) xm <- as.matrix(x[, c(xcol, ycol), with = FALSE]) - + # translations (if any) translation <- NULL if (ncol(m) > 2) { @@ -317,12 +309,12 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( if (isTRUE(inv)) translation <- -translation if (all(translation == c(0, 0))) translation <- NULL } - + # inv translation if (!is.null(translation) && isTRUE(inv)) { xm <- t(t(xm) + translation) } - + # linear transforms aff_m <- m[seq(2), seq(2)] if (isTRUE(inv)) aff_m <- solve(aff_m) @@ -335,7 +327,7 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( x[, (xcol) := xm[, 1L]] x[, (ycol) := xm[, 2L]] - + return(x) } @@ -344,7 +336,7 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( .gaffine_realize_magick <- function(x, size = 5e5, ...) { mg <- .spatraster_sample_values(x, output = "magick", size = size, ...) aff <- x@affine - + # create a dummy spatLocsObj to act as control points # pt1: bottom left # pt2: top left @@ -353,47 +345,54 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( aff_dummy_sl <- dummy_sl %>% affine(.aff_linear_2d(aff)) %>% flip() %>% - rescale(fx = 1 / abs(aff$scale[["x"]]), #*see below - fy = 1 / abs(aff$scale[["y"]])) + rescale( + fx = 1 / abs(aff$scale[["x"]]), #* see below + fy = 1 / abs(aff$scale[["y"]]) + ) # *no scaling should be performed at this step. Otherwise magick # will generate a differently sized image during distortion # To prevent the scaling change, we use the decomposed scale values. # However, flips ARE desired, so we make sure the use the abs() values. - + .sl_to_mat <- function(x) { x[][, c("sdimx", "sdimy")] %>% t() } - + # convert spatlocs of dummy points to matrix ctrl_pts_a <- .sl_to_mat(flip(dummy_sl)) ctrl_pts_b <- .sl_to_mat(aff_dummy_sl) - + ctrl_pts <- c( ctrl_pts_a[, 1], ctrl_pts_b[, 1], ctrl_pts_a[, 2], ctrl_pts_b[, 2], ctrl_pts_a[, 3], ctrl_pts_b[, 3] ) names(ctrl_pts) <- NULL - + mg_aff <- magick::image_distort( - mg, distortion = "Affine", coordinates = ctrl_pts, bestfit = TRUE + mg, + distortion = "Affine", coordinates = ctrl_pts, bestfit = TRUE ) - + d <- .bound_poly(x) %>% affine(aff) - + affine_gimg <- giottoImage( name = paste(objName(x), "affine", collapse = "_"), mg_object = mg_aff, - minmax = c(xmax_sloc = 10, xmin_sloc = 0, - ymax_sloc = 10, ymin_sloc = 0), - boundaries = c(xmax_adj = 0, xmin_adj = 0, - ymax_adj = 0, ymin_adj = 0) + minmax = c( + xmax_sloc = 10, xmin_sloc = 0, + ymax_sloc = 10, ymin_sloc = 0 + ), + boundaries = c( + xmax_adj = 0, xmin_adj = 0, + ymax_adj = 0, ymin_adj = 0 + ) ) - + # assign ext from dummy ext(affine_gimg) <- ext(d) - + return(initialize(affine_gimg)) } @@ -414,7 +413,7 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( #' @examples #' # load example data #' sl <- GiottoData::loadSubObjectMini("spatLocsObj") -#' +#' #' # affine transform matrices #' m <- diag(rep(1, 3)) #' shear_m <- trans_m <- m @@ -422,11 +421,11 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( #' scale_m <- diag(c(2, 3, 1)) #' shear_m[2, 1] <- 2 #' aff_m <- matrix(c( -#' 2, 0.5, 1000, +#' 2, 0.5, 1000, #' -0.3, 3, 20, #' 100, 29, 1 #' ), nrow = 3, byrow = TRUE) -#' +#' #' # create affine objects #' # values are shown in order of operations #' affine(m) @@ -435,26 +434,26 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( #' s <- affine(shear_m) #' a <- affine(aff_m) #' force(a) -#' +#' #' # perform piecewise transforms with decomp -#' +#' #' sl_shear_piecewise <- sl |> #' spin(GiottoUtils::degrees(s$rotate), x0 = 0, y0 = 0) |> #' shear(fx = s$shear[["x"]], fy = s$shear[["y"]], x0 = 0, y0 = 0) |> #' rescale(fx = s$scale[["x"]], fy = s$scale[["y"]], x0 = 0, y0 = 0) |> #' spatShift(dx = s$translate[["x"]], dy = s$translate[["y"]]) -#' +#' #' sl_aff_piecewise <- sl |> #' spin(GiottoUtils::degrees(a$rotate), x0 = 0, y0 = 0) |> #' shear(fx = a$shear[["x"]], fy = a$shear[["y"]], x0 = 0, y0 = 0) |> #' rescale(fx = a$scale[["x"]], fy = a$scale[["y"]], x0 = 0, y0 = 0) |> #' spatShift(dx = a$translate[["x"]], dy = a$translate[["y"]]) -#' +#' #' plot(affine(sl, shear_m)) #' plot(sl_shear_piecewise) #' plot(affine(sl, aff_m)) #' plot(sl_aff_piecewise) -#' +#' .decomp_affine <- function(x) { # should be matrix or coercible to matrix x <- as.matrix(x) @@ -463,28 +462,28 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( a21 <- x[[2, 1]] a12 <- x[[1, 2]] a22 <- x[[2, 2]] - + res_x <- .decomp_affine_xshear(a11, a21, a12, a22) res_y <- .decomp_affine_yshear(a11, a21, a12, a22) res_x_s <- .decomp_affine_simplicity(res_x) res_y_s <- .decomp_affine_simplicity(res_y) - + if (res_y_s > res_x_s) { res <- res_y } else { res <- res_x } - + # apply xy translations if (ncol(x) == 3) { - res$translate = res$translate + x[seq(2), 3] + res$translate <- res$translate + x[seq(2), 3] } else { # append translations x <- cbind(x, rep(0, 2L)) %>% rbind(c(0, 0, 1)) } - + res$affine <- x return(res) } @@ -497,7 +496,7 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( score <- score + sum(a$scale == c(1, 1)) score <- score + sum(a$shear == c(0, 0)) score <- score + sum(a$rotate == 0) - + return(score) } @@ -511,7 +510,7 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( sy <- (a22 - msy * sin(r)) / cos(r) } m <- msy / sy # y shear (no x shear) - + list( scale = c(x = sx, y = sy), rotate = r, @@ -531,7 +530,7 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( sx <- (a11 + msx * sin(r)) / cos(r) } m <- msx / sx # y shear (no x shear) - + list( scale = c(x = sx, y = sy), rotate = r, @@ -553,9 +552,10 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( if (inherits(x, "affine2d")) { x[][seq(2), seq(2)] <- value x <- initialize(x) + } else { + x[seq(2), seq(2)] <- value } - else x[seq(2), seq(2)] <- value - + return(x) } @@ -572,10 +572,6 @@ setMethod("affine", signature(x = "affine2d", y = "matrix"), function( } else { x[seq(2), 3] <- value } - + return(x) } - - - - diff --git a/R/methods-area.R b/R/methods-area.R new file mode 100644 index 00000000..17a49905 --- /dev/null +++ b/R/methods-area.R @@ -0,0 +1,36 @@ +# docs ----------------------------------------------------------- # +#' @title Get the area of individual polygons +#' @name area +#' @description Compute the area covered by polygons +#' @param x `giottoPolygon` +#' @param ... additional args to pass +#' @returns `numeric` vector of spatial area +#' @examples +#' sl <- GiottoData::loadSubObjectMini("spatLocsObj") +#' gpoly <- GiottoData::loadSubObjectMini("giottoPolygon") +#' gpoints <- GiottoData::loadSubObjectMini("giottoPoints") +#' +#' # area of polygons +#' area(gpoly) +#' +#' # area of the convex hull +#' area(convHull(sl)) +#' feature_hulls <- convHull(gpoints, by = "feat_ID") +#' area(feature_hulls) +#' +NULL +# ---------------------------------------------------------------- # + +#' @rdname area +#' @export +setMethod("area", signature("giottoPolygon"), function(x, ...) { + # handle warning about missing CRS + handle_warnings(area(x[], ...))$result +}) + +#' @rdname area +#' @export +setMethod("area", signature("SpatVector"), function(x, ...) { + # handle warning about missing CRS + handle_warnings(terra::expanse(x, transform = FALSE, ...))$result +}) diff --git a/R/methods-coerce.R b/R/methods-coerce.R index 28e3223c..c88fb833 100644 --- a/R/methods-coerce.R +++ b/R/methods-coerce.R @@ -86,9 +86,8 @@ NULL #' @rdname as.data.table #' @method as.data.table SpatVector #' @export -as.data.table.SpatVector <- function( - x, keep.rownames = FALSE, geom = NULL, - include_values = TRUE, ...) { +as.data.table.SpatVector <- function(x, keep.rownames = FALSE, geom = NULL, + include_values = TRUE, ...) { # if looking for polygon XY... if (terra::is.polygons(x)) { if (!is.null(geom)) { @@ -125,16 +124,14 @@ as.data.table.giottoPoints <- function(x, ...) { #' @rdname as.matrix #' @export -setMethod("as.matrix", signature("spatLocsObj"), function( - x, id_rownames = TRUE, ...) { - +setMethod("as.matrix", signature("spatLocsObj"), function(x, id_rownames = TRUE, ...) { x <- x[] # drop to DT spat_cols <- c("sdimx", "sdimy", "sdimz") spat_cols <- spat_cols %in% colnames(x) - + m <- x[, spat_cols, with = FALSE] %>% as.matrix() - + if (id_rownames) { rownames(m) <- x$cell_ID } @@ -178,11 +175,11 @@ methods::setAs("giottoLargeImage", "giottoAffineImage", function(from) { attr(from, "affine") <- new("affine2d") attr(from, "funs") <- list() attr(from, "class") <- "giottoAffineImage" - + initialize(from) }) -# TODO redo this as `as.array`. +# TODO redo this as `as.array`. # Careful: There are already usages of this `as()` method in the code methods::setAs("giottoLargeImage", "array", function(from) { .spatraster_sample_values( @@ -211,9 +208,8 @@ methods::setAs("giottoLargeImage", "array", function(from) { #' @export setMethod( "as.polygons", signature("data.frame"), - function( - x, include_values = TRUE, specific_values = NULL, - sort_geom = FALSE) { + function(x, include_values = TRUE, specific_values = NULL, + sort_geom = FALSE) { .dt_to_spatvector_polygon( dt = data.table::setDT(x), include_values = include_values, @@ -241,7 +237,11 @@ setMethod( } ) - +#' @rdname as.points +#' @export +setMethod("as.points", signature("spatLocsObj"), function(x) { + vect(x[], geom = c("sdimx", "sdimy")) +}) @@ -546,8 +546,9 @@ setMethod( #' @returns data.table #' @description convert spatVector to data.table #' @keywords internal -.spatvector_to_dt <- function(spatvector, - include_values = TRUE) { +.spatvector_to_dt <- function( + spatvector, + include_values = TRUE) { # NSE var geom <- NULL @@ -576,10 +577,11 @@ setMethod( #' 'geom', 'part', and 'hole' columns. #' @returns polygon spatVector #' @keywords internal -.dt_to_spatvector_polygon <- function(dt, - include_values = TRUE, - specific_values = NULL, - sort_geom = FALSE) { +.dt_to_spatvector_polygon <- function( + dt, + include_values = TRUE, + specific_values = NULL, + sort_geom = FALSE) { # DT vars geom <- NULL @@ -639,9 +641,10 @@ setMethod( #' include_values == TRUE #' @returns spatVector for points #' @keywords internal -.dt_to_spatvector_points <- function(dt, - include_values = TRUE, - specific_values = NULL) { +.dt_to_spatvector_points <- function( + dt, + include_values = TRUE, + specific_values = NULL) { all_colnames <- colnames(dt) geom_values <- c("geom", "part", "x", "y", "hole") other_values <- all_colnames[!all_colnames %in% geom_values] 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-crop.R b/R/methods-crop.R index 6ad1d244..10265444 100644 --- a/R/methods-crop.R +++ b/R/methods-crop.R @@ -33,7 +33,9 @@ NULL #' @export setMethod("crop", signature("giottoLargeImage"), function(x, y, ...) { do_crop <- .crop_check(x, y) - if (!do_crop) return(initialize(x)) + if (!do_crop) { + return(initialize(x)) + } x@raster_object <- terra::crop(x@raster_object, y, ...) return(initialize(x)) }) @@ -46,9 +48,11 @@ setMethod("crop", signature("giottoAffineImage"), function(x, y, ...) { d <- .bound_poly(crop_ext) aff <- x@affine img_crop_ext <- ext(affine(d, aff, inv = TRUE)) # find extent in img space - + do_crop <- .crop_check(x@raster_object, img_crop_ext) - if (!do_crop) return(initialize(x)) + if (!do_crop) { + return(initialize(x)) + } x@raster_object <- terra::crop(x@raster_object, img_crop_ext) return(initialize(x)) }) @@ -60,10 +64,12 @@ setMethod("crop", signature("spatLocsObj"), function(x, y, ...) { # NSE vars sdimx <- sdimy <- NULL e <- ext(y) - + do_crop <- .crop_check(x, y) - if (!do_crop) return(x) - + if (!do_crop) { + return(x) + } + b <- .ext_to_num_vec(e) # bounds as a numerical vector x[] <- x[][sdimx >= b[1] & sdimx <= b[2] & sdimy >= b[3] & sdimy <= b[4]] return(x) @@ -77,15 +83,17 @@ setMethod("crop", signature("spatialNetworkObj"), function(x, y, ...) { # NSE vars sdimx_begin <- sdimy_begin <- sdimx_end <- sdimy_end <- NULL e <- ext(y) - + do_crop <- .crop_check(x, y) - if (!do_crop) return(x) - + if (!do_crop) { + return(x) + } + b <- .ext_to_num_vec(e) # bounds as a numerical vector x[] <- x[][sdimx_begin >= b[1] & sdimx_begin <= b[2] & - sdimy_begin >= b[3] & sdimy_begin <= b[4]] + sdimy_begin >= b[3] & sdimy_begin <= b[4]] x[] <- x[][sdimx_end >= b[1] & sdimx_end <= b[2] & - sdimy_end >= b[3] & sdimy_end <= b[4]] + sdimy_end >= b[3] & sdimy_end <= b[4]] return(x) }) @@ -97,9 +105,8 @@ setMethod("crop", signature("spatialNetworkObj"), function(x, y, ...) { #' @export setMethod( "crop", signature("giottoPoints"), - function( - x, y, DT = TRUE, xmin = NULL, xmax = NULL, - ymin = NULL, ymax = NULL, ...) { + function(x, y, DT = TRUE, xmin = NULL, xmax = NULL, + ymin = NULL, ymax = NULL, ...) { checkmate::assert_logical(DT) if (DT) { # converting to DT, subsetting, then regeneration of SpatVector with vect() @@ -114,9 +121,11 @@ setMethod( b <- .determine_crop_bounds( x, y, missing_y, n_single_bounds, xmin, xmax, ymin, ymax ) - + do_crop <- .crop_check(x, b) - if (!do_crop) return(x) + if (!do_crop) { + return(x) + } # 2. convert to DT sv <- x@spatVector @@ -134,7 +143,9 @@ setMethod( # non-DT method. terra default. do_crop <- .crop_check(x, y) - if (!do_crop) return(x) + if (!do_crop) { + return(x) + } x@spatVector <- terra::crop(x@spatVector, y, ...) } @@ -154,9 +165,8 @@ setMethod( #' @export setMethod( "crop", signature("giottoPolygon"), - function( - x, y, DT = TRUE, xmin = NULL, xmax = NULL, ymin = NULL, - ymax = NULL, ...) { + function(x, y, DT = TRUE, xmin = NULL, xmax = NULL, ymin = NULL, + ymax = NULL, ...) { # A. spatVector cropping checkmate::assert_logical(DT) if (DT) { @@ -166,16 +176,20 @@ setMethod( if (missing_y) y <- NULL # make easier to pass as a param downstream n_single_bounds <- 4 - sum( vapply(list(xmin, xmax, ymin, ymax), - is.null, FUN.VALUE = logical(1L)) + is.null, + FUN.VALUE = logical(1L) + ) ) # 1. get final crop bounds (numeric vector of xmin, xmax, ymin, ymax) b <- .determine_crop_bounds( x, y, missing_y, n_single_bounds, xmin, xmax, ymin, ymax ) - + do_crop <- .crop_check(x, b) - if (!do_crop) return(x) + if (!do_crop) { + return(x) + } # 2. convert to DT sv <- x@spatVectorCentroids @@ -198,9 +212,11 @@ setMethod( x@unique_ID_cache <- spatDT[sub_idx, get("poly_ID")] } else { # non-DT method. terra default. - + do_crop <- .crop_check(x, y) - if (!do_crop) return(x) + if (!do_crop) { + return(x) + } args <- list(y = y, ...) x <- .do_gpoly(x, what = terra::crop, args = args) @@ -241,10 +257,9 @@ setMethod( # # returns a numeric vector of the 4 bounds in the order of: # xmin, xmax, ymin, ymax -.determine_crop_bounds <- function( - x, y, missing_y, n_single_bounds, - xmin = NULL, xmax = NULL, ymin = NULL, ymax = NULL, - output = c("numeric", "extent")) { +.determine_crop_bounds <- function(x, y, missing_y, n_single_bounds, + xmin = NULL, xmax = NULL, ymin = NULL, ymax = NULL, + output = c("numeric", "extent")) { # check cropping params output <- match.arg(tolower(output), choices = c("numeric", "extent")) @@ -286,13 +301,13 @@ setMethod( ey <- ext(y) exv <- .ext_to_num_vec(ex) eyv <- .ext_to_num_vec(ey) - + # no overlap in extents if (is.null(terra::intersect(ex, ey))) { warning("crop region is empty", call. = FALSE) return(TRUE) # this will likely be an empty object though } - + # if crop ext (y) fully encapsulates object ext (x): # yes, return FALSE, meaning no crop is needed # no, return TRUE, meaning crop is needed diff --git a/R/methods-dims.R b/R/methods-dims.R index a6368cb2..3c5d36af 100644 --- a/R/methods-dims.R +++ b/R/methods-dims.R @@ -20,6 +20,10 @@ NULL # nrow #### +#' @rdname dims-generic +#' @export +setMethod("nrow", signature("giotto"), function(x) nrow(fDataDT(x))) + #' @rdname dims-generic #' @export setMethod( @@ -79,6 +83,10 @@ setMethod("nrow", signature("dimObj"), function(x) nrow(x@coordinates)) # }) +#' @rdname dims-generic +#' @export +setMethod("ncol", signature("giotto"), function(x) nrow(pDataDT(x))) + #' @rdname dims-generic #' @export setMethod("ncol", signature("exprData"), function(x) ncol(x@exprMat)) @@ -101,6 +109,12 @@ setMethod("ncol", signature("dimObj"), function(x) ncol(x@coordinates)) ## dim() generic #### +#' @rdname dims-generic +#' @export +setMethod("dim", signature("giotto"), function(x) { + c(nrow(x), ncol(x)) +}) + #' @rdname dims-generic #' @export setMethod("dim", signature("spatLocsObj"), function(x) dim(x@coordinates)) diff --git a/R/methods-ext.R b/R/methods-ext.R index db06044d..ed4d38f4 100644 --- a/R/methods-ext.R +++ b/R/methods-ext.R @@ -119,16 +119,17 @@ setMethod("ext", signature("giottoImage"), function(x, ...) { #' only "images" at the moment, which produces a combined `SpatExtent` #' @param verbose be verbose #' @export -setMethod("ext", signature("giotto"), function(x, - spat_unit = ":all:", - feat_type = ":all:", - all_data = TRUE, - prefer = c("polygon", "spatlocs", "points", "images"), - name = list( - spatlocs = ":all:" - ), - verbose = NULL, - ...) { +setMethod("ext", signature("giotto"), function( + x, + spat_unit = ":all:", + feat_type = ":all:", + all_data = TRUE, + prefer = c("polygon", "spatlocs", "points", "images"), + name = list( + spatlocs = ":all:" + ), + verbose = NULL, + ...) { data_types <- c("polygon", "spatlocs", "points", "images") if (!is.null(name)) { @@ -233,7 +234,9 @@ setMethod("ext", signature("giottoAffineImage"), function(x, ...) { ext(x@extent) }) - +#' @rdname ext +#' @export +setMethod("ext", signature("affine2d"), function(x, ...) ext(x@anchor)) @@ -335,3 +338,10 @@ setMethod("ext<-", signature( return(x) }) + +#' @rdname ext +#' @export +setMethod("ext<-", signature("affine2d"), function(x, value) { + x@anchor <- .ext_to_num_vec(value) + return(initialize(x)) +}) diff --git a/R/methods-extract.R b/R/methods-extract.R index 0c8fd7ac..c745f0d3 100644 --- a/R/methods-extract.R +++ b/R/methods-extract.R @@ -12,23 +12,23 @@ NULL #' @param x Giotto S4 object to subset information from #' @param i,j indices specifying elements to extract. Indices are numeric or #' character vectors, or empty -#' @returns Same as `x` unless brackets are empty in which case, the main -#' internal representation is returned. +#' @returns Same as `x` unless brackets are empty in which case, the main +#' internal representation is returned. #' @examples #' gpoints <- GiottoData::loadSubObjectMini("giottoPoints") -#' +#' #' # extract contained `SpatVector` #' gpoints[] -#' +#' #' # subset by feature #' gpoints[c("Mlc1", "Gfap")] -#' +#' #' # subset by feature and colname #' gpoints["Mlc1", c("feat_ID", "feat_ID_uniq")] -#' +#' #' # subset by index #' gpoints[seq(20)] -#' +#' #' @seealso [replace_bracket] [subset_dollar] [replace_dollar] NULL @@ -36,18 +36,18 @@ NULL #' @name replace_bracket #' @aliases `[<-` #' @description Replace values from Giotto Classes. Providing empty brackets -#' such as `x[] <- value` will usually replace the entire contained data +#' such as `x[] <- value` will usually replace the entire contained data #' representation. #' @param x Giotto S4 object to replace information in -#' @param i,j indices specifying elements to replace. Indices are numeric or +#' @param i,j indices specifying elements to replace. Indices are numeric or #' character vectors or empty #' @param value values(s) to set #' @returns same as `x` #' @examples #' gpoints <- GiottoData::loadSubObjectMini("giottoPoints") -#' +#' #' gpoints[] <- gpoints[] -#' +#' #' @seealso [subset_bracket] [subset_dollar] [replace_dollar] NULL @@ -63,9 +63,9 @@ NULL #' @returns same as `x` #' @examples #' gpoints <- GiottoData::loadSubObjectMini("giottoPoints") -#' +#' #' gpoints$new_col <- sprintf("feat_%d", seq(nrow(gpoints))) -#' +#' #' @seealso [subset_bracket] [replace_bracket] [subset_dollar] NULL @@ -85,13 +85,101 @@ NULL #' @seealso [subset_bracket] [replace_bracket] [replace_dollar] NULL +#' @title Subset a `giotto` object +#' @name subset_giotto +#' @aliases `[.giotto` +#' @description Subset a giotto object with `[` or `subset()` generic. The +#' implementation is different from [subsetGiotto()] in that all spatial units +#' will always be affected. The feature type to subset can be specified. +#' @param x a `giotto` object +#' @param feat_ids,i character vector. Feature IDs to subset the object for. +#' @param cell_ids,j character vector. Cell/spatial IDs to subset the object +#' for. +#' @param drop not used +#' @param spat_unit character. Controls which spatial unit to pull subsetting +#' information from when using `cell_ids`/`j` and `subset` params. However, +#' all spatial units will always be affected by the subset. +#' @param feat_type character. Subset affects these feature type(s). Default +#' is `"rna"` +#' @param \dots additional args to pass (none implemented) +#' @examples +#' g <- GiottoData::loadGiottoMini("visium") +#' +#' # `[` examples +#' g[1:5] +#' g[, 2:10] +#' g[1:5, 2:10] +#' g[c(TRUE, FALSE), ] +#' +#' # subset() examples +#' subset(g, nr_feats > 300) +#' subset(g, nr_feats > 300, +#' cell_ids = c("GAATCGCCGGACACGG-1", "GAGGGCATCGCGTATC-1") +#' ) +#' subset(g, Gfap + Gna12 > 10) +#' @returns giotto object +NULL + +#' @title Subset `giotto` subobjects +#' @name subset_giotto_subobjects +#' @aliases `[[.giotto` +#' @description +#' Subset a `giotto` object with `[[` to disassemble it into a list of Giotto +#' S4 subobjects. If `drop` is `FALSE`, the selected subobjects +#' will be reassembled into a new `giotto` object. Note that indexing within +#' the `[[` filters for only those subobjects that have those attributes. +#' This may remove some unexpected information. For specifically splitting the +#' `giotto` object by spatial unit and/or feature type while keeping all +#' expected information, use [sliceGiotto()] +#' @param x giotto object +#' @param spat_unit spatial unit (e.g. "cell") +#' @param feat_type feature type to use (e.g. "rna", "protein") +#' @param i character. Indicates the slot name +#' @param j character. Indicates the subobject name +#' @param drop logical. Default = TRUE +#' @param \dots additional arguments +#' @examples +#' g <- GiottoData::loadGiottoMini("vizgen") +#' force(g) +#' +#' # return as lists of subobjects with drop = TRUE (default) +#' g[[, "raw"]] +#' g[["expression", spat_unit = "aggregate"]] +#' +#' # return as a subset giotto object with drop = FALSE +#' g[[, "raw", drop = FALSE]] +#' g[[spat_unit = "aggregate", drop = FALSE]] +#' @returns giotto subobject +NULL # --------------------------------------------------------------------------- # # $ S4 access generic #### -## * coordDataDT #### +#' @describeIn subset_dollar Subset giotto object +setMethod( + "$", signature("giotto"), function(x, name) { + spatValues(x, feats = name)[[name]] + } +) + +#' @rdname replace_dollar +setMethod( + "$<-", signature("giotto"), function(x, name, value) { + cx <- getCellMetadata(x, output = "data.table", copy_obj = FALSE) + cx[, (name) := value] + return(x) + } +) + +#' @export +.DollarNames.giotto <- function(x, pattern) { + colnames(pDataDT(x)) +} + + +## * coordDataDT #### #' @rdname subset_dollar #' @section \code{`$`} methods: #' Select by colname from giotto S4 data.table coordinates slot. @@ -263,6 +351,7 @@ setMethod("$", signature("affine2d"), function(x, name) { # [ S4 access generic #### + ## * gdtData #### # Make it so that i and j subsets can be written independently @@ -1030,6 +1119,50 @@ setMethod( } ) +# * giottoLargeImage #### +#' @rdname subset_bracket +#' @export +setMethod( + "[", + signature(x = "giottoLargeImage", i = "missing", j = "missing", drop = "missing"), + function(x, i, j) { + x@raster_object + } +) + +#' @rdname replace_bracket +#' @export +setMethod( + "[<-", + signature(x = "giottoLargeImage", i = "missing", j = "missing", value = "ANY"), + function(x, i, j, value) { + x@raster_object <- value + return(initialize(x)) + } +) + +# * giottoImage #### +#' @rdname subset_bracket +#' @export +setMethod( + "[", + signature(x = "giottoImage", i = "missing", j = "missing", drop = "missing"), + function(x, i, j) { + x@mg_object + } +) + +#' @rdname replace_bracket +#' @export +setMethod( + "[<-", + signature(x = "giottoImage", i = "missing", j = "missing", value = "ANY"), + function(x, i, j, value) { + x@mg_object <- value + return(initialize(x)) + } +) + #' @rdname subset_bracket #' @export setMethod( @@ -1057,3 +1190,417 @@ setMethod( return(initialize(x)) } ) + + + + + +# giotto subsets #### + + + +# * [ #### + +#' @rdname subset_giotto +#' @export +setMethod( + "[", signature(x = "giotto", i = "gIndex", j = "missing", drop = "missing"), + function(x, i, ..., drop) { + subset(x, feat_ids = i, ...) + } +) + +#' @rdname subset_giotto +#' @export +setMethod( + "[", signature(x = "giotto", i = "missing", j = "gIndex", drop = "missing"), + function(x, j, ..., drop) { + subset(x, cell_ids = j, ...) + } +) + +#' @rdname subset_giotto +#' @export +setMethod( + "[", signature(x = "giotto", i = "gIndex", j = "gIndex", drop = "missing"), + function(x, i, j, ..., drop) { + subset(x, feat_ids = i, cell_ids = j, ...) + } +) + +#' @describeIn subset_giotto Subset giotto objects +setMethod( + "[", signature(x = "giotto", i = "missing", j = "missing", drop = "missing"), + function(x, ...) { + x[[...]] + } +) + +# * [[ #### + +#' @rdname subset_giotto_subobjects +#' @export +setMethod( + "[[", signature(x = "giotto", i = "missing", j = "missing"), + function(x, spat_unit = NULL, feat_type = NULL, drop = TRUE, ...) { + res <- as.list( + x, + spat_unit = spat_unit, feat_type = feat_type, ... + ) + if (drop) { + return(res) + } else { + g <- giotto(initialize = FALSE, instructions = instructions(x)) + g <- setGiotto(g, res, verbose = FALSE) + if (!is.null(spat_unit)) activeSpatUnit(g) <- spat_unit[[1]] + if (!is.null(feat_type)) activeFeatType(g) <- feat_type[[1]] + return(g) + } + } +) + +#' @rdname subset_giotto_subobjects +#' @export +setMethod( + "[[", signature(x = "giotto", i = "character", j = "missing"), + function(x, i, spat_unit = NULL, feat_type = NULL, drop = TRUE, ...) { + res <- as.list( + x, + slots = i, spat_unit = spat_unit, feat_type = feat_type, ... + ) + if (drop) { + return(res) + } else { + g <- giotto(initialize = FALSE, instructions = instructions(x)) + g <- setGiotto(g, res, verbose = FALSE) + if (!is.null(spat_unit)) activeSpatUnit(g) <- spat_unit[[1]] + if (!is.null(feat_type)) activeFeatType(g) <- feat_type[[1]] + return(g) + } + } +) + +#' @rdname subset_giotto_subobjects +#' @export +setMethod( + "[[", signature(x = "giotto", i = "missing", j = "character"), + function(x, j, spat_unit = NULL, feat_type = NULL, drop = TRUE, ...) { + res <- as.list(x, + name = j, + spat_unit = spat_unit, + feat_type = feat_type, + ... + ) + if (drop) { + return(res) + } else { + g <- giotto(initialize = FALSE, instructions = instructions(x)) + g <- setGiotto(g, res, verbose = FALSE) + if (!is.null(spat_unit)) activeSpatUnit(g) <- spat_unit[[1]] + if (!is.null(feat_type)) activeFeatType(g) <- feat_type[[1]] + if (is.null(activeSpatUnit(g))) { + su <- spatUnit(res) + activeSpatUnit(g) <- su[!is.na(su)][[1L]] + } + if (is.null(activeFeatType(g))) { + ft <- featType(res) + activeFeatType(g) <- ft[!is.na(ft)][[1L]] + } + return(g) + } + } +) + +#' @rdname subset_giotto_subobjects +#' @export +setMethod( + "[[", signature(x = "giotto", i = "character", j = "character"), + function(x, i, j, spat_unit = NULL, feat_type = NULL, drop = TRUE, ...) { + res <- as.list(x, + slots = i, + name = j, + spat_unit = spat_unit, + feat_type = feat_type, + ... + ) + if (drop) { + return(res) + } else { + g <- giotto(initialize = FALSE, instructions = instructions(x)) + g <- setGiotto(g, res, verbose = FALSE) + if (!is.null(spat_unit)) activeSpatUnit(g) <- spat_unit[[1]] + if (!is.null(feat_type)) activeFeatType(g) <- feat_type[[1]] + if (is.null(activeSpatUnit(g))) { + su <- spatUnit(res) + activeSpatUnit(g) <- su[!is.na(su)][[1L]] + } + if (is.null(activeFeatType(g))) { + ft <- featType(res) + activeFeatType(g) <- ft[!is.na(ft)][[1L]] + } + return(g) + } + } +) + + + +#' @rdname subset_giotto +#' @param subset Logical expression evaluated in expression values +#' @param negate logical. if `TRUE` all IDs that are **not** in the `subset` +#' are selected +#' @param quote logical. If `TRUE`, the `subset` param will be quoted with +#' `substitute()`. Set this to `FALSE` when calling from a function, although +#' that may not be recommended since NSE output can be unexpected when not used +#' interactively. +#' @param \dots additional params to pass to `spatValues` used with the +#' subset param +#' @export +setMethod("subset", signature("giotto"), function(x, + subset, + feat_ids = NULL, + cell_ids = NULL, + spat_unit = NULL, + feat_type = NULL, + negate = FALSE, + quote = TRUE, + ...) { + spat_unit <- set_default_spat_unit( + x, spat_unit + ) + feat_type <- set_default_feat_type( + x, + spat_unit = spat_unit, feat_type = feat_type + ) + + # setup vars for subsetting IDs + fids <- NULL + sids <- NULL + + # indexing and specified IDs + if (!is.null(feat_ids)) { + if (is.numeric(feat_ids) || is.logical(feat_ids)) { + fx <- fDataDT(x, + spat_unit = spat_unit, + feat_type = feat_type + ) + if (is.logical(feat_ids)) { + fn <- nrow(fx) + if (length(feat_ids) != fn) { + feat_ids <- rep_len(feat_ids, length.out = fn) + } + } + fids <- fx[feat_ids]$feat_ID + } else if (is.character(feat_ids)) { + fids <- feat_ids + } else if (is.factor(feat_ids)) { + fids <- as.character(fids) + } + } + + if (!is.null(cell_ids)) { + if (is.numeric(cell_ids) || is.logical(cell_ids)) { + cx <- pDataDT(x, + spat_unit = spat_unit, + feat_type = feat_type + ) + if (is.logical(cell_ids)) { + cn <- nrow(cx) + if (length(cell_ids) != cn) { + cell_ids <- rep_len(cell_ids, length.out = cn) + } + } + sids <- cx[cell_ids]$cell_ID + } else if (is.character(cell_ids)) { + sids <- cell_ids + } else if (is.factor(cell_ids)) { + sids <- as.character(sids) + } + } + + # expression evals ------------------------------------------------- # + if (quote) { + sub_s <- substitute(subset) + } else { + sub_s <- subset + } + if (negate) sub_s <- call("!", sub_s) + + if (!missing(sub_s)) { + vars <- all.vars(sub_s) + vals <- lapply(vars, function(v) { + spatValues(x, + feats = v, + spat_unit = spat_unit, + feat_type = feat_type, + verbose = FALSE, + ... + ) + }) + .dtjoin <- function(x, y) { + x[y, on = "cell_ID"] + } + vals_dt <- Reduce(.dtjoin, vals) + if (identical(getOption("giotto.verbose"), "debug")) { + message("data.table used in subset") + print(vals_dt) + } + sids_s <- subset.data.frame(vals_dt, subset = eval(sub_s))$cell_ID + + if (is.null(sids)) { + sids <- sids_s + } else { + checkmate::assert_character(sids) + sids <- intersect(sids_s, sids) + } + } + + subsetGiotto(x, + spat_unit = ":all:", + feat_type = feat_type, + feat_ids = fids, + cell_ids = sids, + poly_info = spat_unit + ) +}) + + + + + +#' @name sliceGiotto +#' @title Slice `giotto` object by `spat_unit` and `feat_type` +#' @description Extract specific spatial units and feature types from a +#' `giotto` object as independent `giotto` objects. +#' @param gobject `giotto` object +#' @param spat_unit character vector. Spatial units to slice out. ":all:" +#' means keeping all of them in the output +#' @param feat_type character vector. Feature types to slice out. ":all:" +#' means keeping all of them in the output +#' @param verbose be verbose +#' @returns `giotto` object +#' @examples +#' g <- GiottoData::loadGiottoMini("vizgen") +#' res <- sliceGiotto(g, spat_unit = "aggregate") +#' force(res) +#' @seealso [subsetGiotto()] [subset_giotto] +#' @export +sliceGiotto <- function(gobject, spat_unit = ":all:", feat_type = ":all:", verbose = FALSE) { + spat_unit <- spat_unit %null% ":all:" + feat_type <- feat_type %null% ":all:" + x <- gobject # shorter name + + if (identical(spat_unit, ":all:") && identical(feat_type, ":all:")) { + return(x) # return early if no slicing needed + } + + # data slots + spat_only_slots <- c("spatial_info", "spatial_locs", "spatial_network") + feat_only_slots <- c("feat_info") + spat_feat_slots <- c( + "expression", "cell_metadata", "feat_metadata", "spatial_enrichment", + "nn_network", "dimension_reduction", "multiomics" + ) + + spat_only <- x[[spat_only_slots]] + feat_only <- x[[feat_only_slots]] + spat_feat <- x[[spat_feat_slots]] + + # select data + if (!identical(spat_unit, ":all:")) { # select if not all + activeSpatUnit(x) <- spat_unit[[1L]] + spat_only <- spat_only[spatUnit(spat_only) %in% spat_unit] + spat_feat <- spat_feat[spatUnit(spat_feat) %in% spat_unit] + } + + if (!identical(feat_type, ":all:")) { + activeFeatType(x) <- feat_type[[1L]] + feat_only <- feat_only[featType(feat_only) %in% feat_type] + spat_feat <- spat_feat[featType(spat_feat) %in% feat_type] + } + + # combine selected data + datalist <- c(spat_only, feat_only, spat_feat) + + g <- giotto( + images = x@images, + parameters = x@parameters, + instructions = x@instructions, + offset_file = x@offset_file, + versions = x@versions, + join_info = x@join_info, + h5_file = x@h5_file, + initialize = FALSE + ) + g <- setGiotto(g, + datalist, + initialize = FALSE, + verbose = FALSE + ) + + return(initialize(g)) +} + +# * as.list #### + +#' @rdname as.list +#' @title Coerce to a list +#' @docType methods +#' @method as.list giotto +#' @description Generic to coerce to a list if possible +#' @param x the object to coerce +#' @param slots character vector. Which data slots to include in list. See +#' details +#' @param spat_unit spatial unit (e.g. "cell") +#' @param feat_type feature type to use (e.g. "rna", "protein") +#' @param name name of the elements to select from the slot +#' @param \dots additional arguments +#' @details +#' * Giotto method - the slots argument currently accepts any or multiple of: +#' `"spatial_info", "spatial_locs", "spatial_network", "feat_info", +#' "expression", "cell_metadata", "feat_metadata", "spatial_enrichment", +#' "nn_network", "dimension_reduction", "multiomics"` +#' @returns list +#' @exportMethod as.list +setMethod("as.list", signature("giotto"), function(x, slots, spat_unit = NULL, feat_type = NULL, name = NULL, ...) { + dataslots <- c( + "spatial_info", "spatial_locs", "spatial_network", "feat_info", + "expression", "cell_metadata", "feat_metadata", "spatial_enrichment", + "nn_network", "dimension_reduction", "multiomics", "images" + ) + + .giotto_datalist <- function(x, slots) { + lapply(slots, function(gslot) methods::slot(x, gslot)) |> + unlist(recursive = TRUE, use.names = FALSE) + } + + if (missing(slots)) slots <- dataslots + slots <- match.arg(slots, choices = dataslots, several.ok = TRUE) + res <- do.call(.giotto_datalist, list(x = x, slots = slots)) + + if (!is.null(name)) { + res <- .dbrkt_on_filter(res, name) + } + if (!is.null(spat_unit)) { + res <- .dbrkt_su_filter(res, spat_unit) + } + if (!is.null(feat_type)) { + res <- .dbrkt_ft_filter(res, feat_type) + } + return(res) +}) + + +# internals #### +# suspend slot checking until all items in list are supplied + + +.dbrkt_su_filter <- function(x, y) { + x[spatUnit(x) %in% y | inherits(x, "giottoLargeImage")] +} +.dbrkt_ft_filter <- function(x, y) { + x[featType(x) %in% y | inherits(x, "giottoLargeImage")] +} +.dbrkt_on_filter <- function(x, y) { + x[objName(x) %in% y] +} diff --git a/R/methods-flip.R b/R/methods-flip.R index ff7609cd..705b6a11 100644 --- a/R/methods-flip.R +++ b/R/methods-flip.R @@ -25,10 +25,11 @@ NULL #' @export setMethod( "flip", signature("giotto"), - function(x, direction = "vertical", - x0 = 0, y0 = 0, - spat_unit = ":all:", feat_type = ":all:", - ...) { + function( + x, direction = "vertical", + x0 = 0, y0 = 0, + spat_unit = ":all:", feat_type = ":all:", + ...) { a <- list(direction = direction, x0 = x0, y0 = y0, ...) checkmate::assert_character(spat_unit) @@ -165,9 +166,7 @@ setMethod( #' @rdname flip #' @export -setMethod("flip", signature("giottoLargeImage"), function( - x, direction = "vertical", x0 = 0, y0 = 0 -) { +setMethod("flip", signature("giottoLargeImage"), function(x, direction = "vertical", x0 = 0, y0 = 0) { a <- get_args_list() a$x <- as(x, "giottoAffineImage") # convert to giottoAffineImage res <- do.call(flip, args = a) @@ -176,22 +175,18 @@ setMethod("flip", signature("giottoLargeImage"), function( #' @rdname flip #' @export -setMethod("flip", signature("giottoAffineImage"), function( - x, direction = "vertical", x0 = 0, y0 = 0 -) { +setMethod("flip", signature("giottoAffineImage"), function(x, direction = "vertical", x0 = 0, y0 = 0) { a <- get_args_list() a$x <- x@affine # update affine x@affine <- do.call(flip, args = a) - + return(initialize(x)) }) #' @rdname flip #' @export -setMethod("flip", signature("affine2d"), function( - x, direction = "vertical", x0 = 0, y0 = 0 -) { +setMethod("flip", signature("affine2d"), function(x, direction = "vertical", x0 = 0, y0 = 0) { direction <- match.arg(direction, choices = c("vertical", "horizontal")) aff <- x@affine @@ -207,7 +202,7 @@ setMethod("flip", signature("affine2d"), function( ) .aff_linear_2d(aff) <- .aff_linear_2d(aff) %*% flip_m .aff_shift_2d(aff) <- xyshift - + x@affine <- aff return(initialize(x)) }) @@ -230,10 +225,11 @@ setMethod("flip", signature("affine2d"), function( #' to flip over the extent #' @keywords internal #' @noRd -.flip_gpoly <- function(gpoly, - direction = "vertical", - x0 = 0, - y0 = 0) { +.flip_gpoly <- function( + gpoly, + direction = "vertical", + x0 = 0, + y0 = 0) { checkmate::assert_class(gpoly, "giottoPolygon") checkmate::assert_character(direction) if (!is.null(x0)) { @@ -385,10 +381,11 @@ setMethod("flip", signature("affine2d"), function( #' to flip over the extent #' @keywords internal #' @noRd -.flip_large_image <- function(image, - direction = "vertical", - x0 = 0, - y0 = 0) { +.flip_large_image <- function( + image, + direction = "vertical", + x0 = 0, + y0 = 0) { checkmate::assert_class(image, "giottoLargeImage") checkmate::assert_character(direction) if (!is.null(x0)) { @@ -435,10 +432,11 @@ setMethod("flip", signature("affine2d"), function( #' to flip over the extent #' @keywords internal #' @noRd -.flip_gpoints <- function(gpoints, - direction = "vertical", - x0 = 0, - y0 = 0) { +.flip_gpoints <- function( + gpoints, + direction = "vertical", + x0 = 0, + y0 = 0) { checkmate::assert_class(gpoints, "giottoPoints") checkmate::assert_character(direction) if (!is.null(x0)) { @@ -492,11 +490,12 @@ setMethod("flip", signature("affine2d"), function( #' to flip over the extent #' @keywords internal #' @noRd -.flip_spatlocs <- function(sl, - direction = "vertical", - x0 = 0, - y0 = 0, - copy_obj = TRUE) { +.flip_spatlocs <- function( + sl, + direction = "vertical", + x0 = 0, + y0 = 0, + copy_obj = TRUE) { sdimy <- sdimx <- NULL checkmate::assert_class(sl, "spatLocsObj") @@ -537,11 +536,12 @@ setMethod("flip", signature("affine2d"), function( #' to flip over the extent #' @keywords internal #' @noRd -.flip_spatnet <- function(sn, - direction = "vertical", - x0 = 0, - y0 = 0, - copy_obj = TRUE) { +.flip_spatnet <- function( + sn, + direction = "vertical", + x0 = 0, + y0 = 0, + copy_obj = TRUE) { sdimy_begin <- sdimy_end <- sdimx_begin <- sdimx_end <- NULL checkmate::assert_class(sn, "spatialNetworkObj") @@ -607,10 +607,11 @@ setMethod("flip", signature("affine2d"), function( #' to flip over the extent #' @keywords internal #' @noRd -.flip_extent <- function(e, - direction = "vertical", - x0 = 0, - y0 = 0) { +.flip_extent <- function( + e, + direction = "vertical", + x0 = 0, + y0 = 0) { checkmate::assert_class(e, "SpatExtent") checkmate::assert_character(direction) if (!is.null(x0)) { diff --git a/R/methods-initialize.R b/R/methods-initialize.R index a37e403d..84073d20 100644 --- a/R/methods-initialize.R +++ b/R/methods-initialize.R @@ -11,222 +11,228 @@ NULL # See documentation in classes.R #' @noRd #' @keywords internal -setMethod("initialize", signature("giotto"), function(.Object, ...) { - .Object <- methods::callNextMethod() - .Object <- updateGiottoObject(.Object) +setMethod( + "initialize", signature("giotto"), + function(.Object, ..., initialize = TRUE) { + .Object <- methods::callNextMethod(.Object, ...) + if (!initialize || isFALSE(getOption("giotto.init", TRUE))) { + return(.Object) + } + .Object <- updateGiottoObject(.Object) + vmsg(.is_debug = TRUE, .initial = " ", "!!giotto.initialize run!!") - # DT vars - spat_unit <- feat_type <- NULL + # DT vars + spat_unit <- feat_type <- NULL - # a = list(...) + # a = list(...) - # TODO - ## set slots ## - ## --------- ## + # TODO + ## set slots ## + ## --------- ## - # if('spatial_info' %in% names(a)) { - # .Object = setPolygonInfo(.Object, gpolygon = a$spatial_info) - # } - # if('expression' %in% names(a)) { - # .Object = setExpression(.Object, values = a$expression) - # } + # if('spatial_info' %in% names(a)) { + # .Object = setPolygonInfo(.Object, gpolygon = a$spatial_info) + # } + # if('expression' %in% names(a)) { + # .Object = setExpression(.Object, values = a$expression) + # } - ## set instructions ## - ## ---------------- ## + ## set instructions ## + ## ---------------- ## - # set default instructions (make sure initialize = FALSE) - if (is.null(instructions(.Object))) { - instructions(.Object, initialize = FALSE) <- createGiottoInstructions() - } + # set default instructions (make sure initialize = FALSE) + if (is.null(instructions(.Object))) { + instructions(.Object, initialize = FALSE) <- createGiottoInstructions() + } - ## test python module availability if a python env is expected ## - .check_giotto_python_modules( - my_python_path = instructions(.Object, "python_path") - ) + ## test python module availability if a python env is expected ## + .check_giotto_python_modules( + my_python_path = instructions(.Object, "python_path") + ) - ## Slot Detection ## - ## -------------- ## + ## Slot Detection ## + ## -------------- ## - # detect expression and subcellular data - avail_expr <- list_expression(.Object) - avail_si <- list_spatial_info(.Object) - avail_fi <- list_feature_info(.Object) + # detect expression and subcellular data + avail_expr <- list_expression(.Object) + avail_si <- list_spatial_info(.Object) + avail_fi <- list_feature_info(.Object) - used_spat_units <- unique(c(avail_expr$spat_unit, avail_si$spat_info)) - used_feat_types <- unique(c(avail_expr$feat_type, avail_fi$feat_info)) + used_spat_units <- unique(c(avail_expr$spat_unit, avail_si$spat_info)) + used_feat_types <- unique(c(avail_expr$feat_type, avail_fi$feat_info)) - # detect ID slots - avail_cid <- list_cell_id_names(.Object) - avail_fid <- list_cell_id_names(.Object) + # detect ID slots + avail_cid <- list_cell_id_names(.Object) + avail_fid <- list_cell_id_names(.Object) - # detect metadata slots - avail_cm <- list_cell_metadata(.Object) - avail_fm <- list_feat_metadata(.Object) + # detect metadata slots + avail_cm <- list_cell_metadata(.Object) + avail_fm <- list_feat_metadata(.Object) - # detect spatial location slot - avail_sl <- list_spatial_locations(.Object) + # detect spatial location slot + avail_sl <- list_spatial_locations(.Object) - # detect nearest network slot - avail_nn <- list_nearest_networks(.Object) + # detect nearest network slot + avail_nn <- list_nearest_networks(.Object) - # detect dimension reduction slot - avail_dr <- list_dim_reductions(.Object) + # detect dimension reduction slot + avail_dr <- list_dim_reductions(.Object) - # detect spatial network slot - avail_sn <- list_spatial_networks(.Object) + # detect spatial network slot + avail_sn <- list_spatial_networks(.Object) - # detect spatial enrichment slot - avail_se <- list_spatial_enrichments(.Object) + # detect spatial enrichment slot + avail_se <- list_spatial_enrichments(.Object) - ## Perform any subobject updates ## - ## ----------------------------- ## + ## 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 - ) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - } + # 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) + # 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")) { - info <- updateGiottoPolygonObject(info) - } - return(info) - }) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - .Object <- setPolygonInfo( - gobject = .Object, - x = info_list, - verbose = FALSE, - centroids_to_spatlocs = FALSE, - initialize = FALSE - ) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - } + # 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 <- 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 ## - ## ------------------------------------------ ## + ## Set active/default spat_unit and feat_type ## + ## ------------------------------------------ ## - # detect if actives are set in giotto instructions - active_su <- try(instructions(.Object, "active_spat_unit"), silent = TRUE) - active_ft <- try(instructions(.Object, "active_feat_type"), silent = TRUE) + # detect if actives are set in giotto instructions + active_su <- try(instructions(.Object, "active_spat_unit"), silent = TRUE) + active_ft <- try(instructions(.Object, "active_feat_type"), silent = TRUE) - # determine actives using defaults if data exists then set - if (inherits(active_su, "try-error")) { - if (!is.null(avail_expr) | !is.null(avail_si)) { - active_su <- set_default_spat_unit(gobject = .Object) - instructions(.Object, "active_spat_unit", - initialize = FALSE - ) <- active_su + # determine actives using defaults if data exists then set + if (inherits(active_su, "try-error")) { + if (!is.null(avail_expr) | !is.null(avail_si)) { + active_su <- set_default_spat_unit(gobject = .Object) + instructions(.Object, "active_spat_unit", + initialize = FALSE + ) <- active_su + } } - } - if (inherits(active_ft, "try-error")) { - if (!is.null(avail_expr) | !is.null(avail_fi)) { - active_ft <- set_default_feat_type( - gobject = .Object, - spat_unit = active_su - ) - instructions(.Object, "active_feat_type", - initialize = FALSE - ) <- active_ft + if (inherits(active_ft, "try-error")) { + if (!is.null(avail_expr) | !is.null(avail_fi)) { + active_ft <- set_default_feat_type( + gobject = .Object, + spat_unit = active_su + ) + instructions(.Object, "active_feat_type", + initialize = FALSE + ) <- active_ft + } } - } - ## Set expression_feat ## - ## ------------------- ## - e_feat <- used_feat_types - if ("rna" %in% e_feat) { - rna_idx <- which(e_feat == "rna") - e_feat <- c(e_feat[rna_idx], e_feat[-rna_idx]) - } - .Object@expression_feat <- e_feat + ## Set expression_feat ## + ## ------------------- ## + e_feat <- used_feat_types + if ("rna" %in% e_feat) { + rna_idx <- which(e_feat == "rna") + e_feat <- c(e_feat[rna_idx], e_feat[-rna_idx]) + } + .Object@expression_feat <- e_feat - ## Ensure Consistent IDs ## - ## --------------------- ## + ## Ensure Consistent IDs ## + ## --------------------- ## - # cell IDs can be expected to be constant across a spatial unit + # cell IDs can be expected to be constant across a spatial unit - # expression - if (!is.null(avail_expr)) { - unique_expr_sets <- unique(avail_expr[, .(spat_unit, feat_type)]) + # expression + if (!is.null(avail_expr)) { + unique_expr_sets <- unique(avail_expr[, .(spat_unit, feat_type)]) - for (set_i in nrow(unique_expr_sets)) { - exp_list <- get_expression_values_list( - gobject = .Object, - spat_unit = unique_expr_sets$spat_unit[[set_i]], - feat_type = unique_expr_sets$feat_type[[set_i]], - output = "exprObj", - set_defaults = FALSE - ) + for (set_i in nrow(unique_expr_sets)) { + exp_list <- get_expression_values_list( + gobject = .Object, + spat_unit = unique_expr_sets$spat_unit[[set_i]], + feat_type = unique_expr_sets$feat_type[[set_i]], + output = "exprObj", + set_defaults = FALSE + ) - exp_list_names <- lapply(exp_list, spatIDs) - list_match <- vapply( - exp_list_names, - setequal, - exp_list_names[[1L]], - FUN.VALUE = logical(1L) - ) - if (!all(list_match)) { - wrap_msg(list_match) - warning(wrap_txt( - "spat_unit:", unique_expr_sets$spat_unit[[set_i]], "/", - "feat_type:", unique_expr_sets$feat_type[[set_i]], - "\nNot all expression matrices share the same cell_IDs" - )) + exp_list_names <- lapply(exp_list, spatIDs) + list_match <- vapply( + exp_list_names, + setequal, + exp_list_names[[1L]], + FUN.VALUE = logical(1L) + ) + if (!all(list_match)) { + wrap_msg(list_match) + warning(wrap_txt( + "spat_unit:", unique_expr_sets$spat_unit[[set_i]], "/", + "feat_type:", unique_expr_sets$feat_type[[set_i]], + "\nNot all expression matrices share the same cell_IDs" + )) + } } } - } - # MIGHT BE CHANGED IN THE FUTURE - # feat_IDs cannot be expected to be constant across spat units. + # MIGHT BE CHANGED IN THE FUTURE + # feat_IDs cannot be expected to be constant across spat units. @@ -234,235 +240,242 @@ setMethod("initialize", signature("giotto"), function(.Object, ...) { - ## ID initialization ## - ## ----------------- ## + ## ID initialization ## + ## ----------------- ## - # Must be after default spat_unit/feat_type are set. - # feat_ID initialization depends on active spat_unit + # Must be after default spat_unit/feat_type are set. + # feat_ID initialization depends on active spat_unit - # Initialization of cell_ID and feat_ID slots. These slots hold their # - # respective IDs for each spatial unit and feature type respectively. # - # # - # cell_metadata and feat_metadata slots are initialized off these slots. # - # # - # expression information is PREFERRED for ID initialization. # - # subcellular information, being raw data may also be used. # + # Initialization of cell_ID and feat_ID slots. These slots hold their # + # respective IDs for each spatial unit and feature type respectively. # + # # + # cell_metadata and feat_metadata slots are initialized off these slots. # + # # + # expression information is PREFERRED for ID initialization. # + # subcellular information, being raw data may also be used. # - .Object <- init_cell_and_feat_IDs(gobject = .Object) + .Object <- init_cell_and_feat_IDs(gobject = .Object) - ## Metadata initialization ## - ## ----------------------- ## + ## Metadata initialization ## + ## ----------------------- ## - # Initialization of all spat_unit/feat_type combinations if the metadata # - # does not currently exist. # + # Initialization of all spat_unit/feat_type combinations if the metadata # + # does not currently exist. # - # provenance is always updated from matched expression info if existing + # provenance is always updated from matched expression info if existing - for (spatial_unit in used_spat_units) { - for (feature_type in used_feat_types) { - provenance <- NULL - # get expression for provenance info - if (!is.null(avail_expr)) { - if (nrow(avail_expr[spat_unit == spatial_unit & - feat_type == feature_type]) != 0L) { - provenance <- prov(getExpression( + for (spatial_unit in used_spat_units) { + for (feature_type in used_feat_types) { + provenance <- NULL + # get expression for provenance info + if (!is.null(avail_expr)) { + if (nrow(avail_expr[spat_unit == spatial_unit & + feat_type == feature_type]) != 0L) { + provenance <- prov(getExpression( + gobject = .Object, + spat_unit = spatial_unit, + feat_type = feature_type, + output = "exprObj", + set_defaults = FALSE + )) + } + } + + # initialize if no metadata exists OR none for this spat/feat + + # cell metadata + if (is.null(avail_cm)) { + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### + .Object <- set_cell_metadata( gobject = .Object, + metadata = "initialize", spat_unit = spatial_unit, feat_type = feature_type, - output = "exprObj", - set_defaults = FALSE - )) + verbose = FALSE, + initialize = FALSE + ) + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### + } else if (nrow(avail_cm[spat_unit == spatial_unit & + feat_type == feature_type]) == 0L) { + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### + .Object <- set_cell_metadata( + gobject = .Object, + metadata = "initialize", + spat_unit = spatial_unit, + feat_type = feature_type, + verbose = FALSE, + initialize = FALSE + ) + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### } - } - # initialize if no metadata exists OR none for this spat/feat + # feature metadata + if (is.null(avail_fm)) { + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### + .Object <- set_feature_metadata( + gobject = .Object, + metadata = "initialize", + spat_unit = spatial_unit, + feat_type = feature_type, + verbose = FALSE, + initialize = FALSE + ) + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### + } else if (nrow(avail_fm[spat_unit == spatial_unit & + feat_type == feature_type]) == 0L) { + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### + .Object <- set_feature_metadata( + gobject = .Object, + metadata = "initialize", + spat_unit = spatial_unit, + feat_type = feature_type, + verbose = FALSE, + initialize = FALSE + ) + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### + } - # cell metadata - if (is.null(avail_cm)) { - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - .Object <- set_cell_metadata( + + # update provenance (always happens for all metadata objects) + if (is.null(provenance)) next() # skip if no provenance info + + cm <- getCellMetadata( gobject = .Object, - metadata = "initialize", spat_unit = spatial_unit, feat_type = feature_type, - verbose = FALSE, - initialize = FALSE + output = "cellMetaObj", + copy_obj = FALSE, + set_defaults = FALSE ) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - } else if (nrow(avail_cm[spat_unit == spatial_unit & - feat_type == feature_type]) == 0L) { - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - .Object <- set_cell_metadata( + fm <- getFeatureMetadata( gobject = .Object, - metadata = "initialize", spat_unit = spatial_unit, feat_type = feature_type, - verbose = FALSE, - initialize = FALSE + output = "featMetaObj", + copy_obj = FALSE, + set_defaults = FALSE ) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - } - - # feature metadata - if (is.null(avail_fm)) { - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - .Object <- set_feature_metadata( + prov(cm) <- provenance + prov(fm) <- provenance + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### + .Object <- set_cell_metadata( gobject = .Object, - metadata = "initialize", - spat_unit = spatial_unit, - feat_type = feature_type, + metadata = cm, verbose = FALSE, initialize = FALSE ) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - } else if (nrow(avail_fm[spat_unit == spatial_unit & - feat_type == feature_type]) == 0L) { - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### .Object <- set_feature_metadata( gobject = .Object, - metadata = "initialize", - spat_unit = spatial_unit, - feat_type = feature_type, + metadata = fm, verbose = FALSE, initialize = FALSE ) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### + ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### } - - - # update provenance (always happens for all metadata objects) - if (is.null(provenance)) next() # skip if no provenance info - - cm <- getCellMetadata( - gobject = .Object, - spat_unit = spatial_unit, - feat_type = feature_type, - output = "cellMetaObj", - copy_obj = FALSE, - set_defaults = FALSE - ) - fm <- getFeatureMetadata( - gobject = .Object, - spat_unit = spatial_unit, - feat_type = feature_type, - output = "featMetaObj", - copy_obj = FALSE, - set_defaults = FALSE - ) - prov(cm) <- provenance - prov(fm) <- provenance - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### - .Object <- set_cell_metadata( - gobject = .Object, - metadata = cm, - verbose = FALSE, - initialize = FALSE - ) - .Object <- set_feature_metadata( - gobject = .Object, - metadata = fm, - verbose = FALSE, - initialize = FALSE - ) - ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### ### } - } + # SLOT CHECKS #### - ## Metadata ## - ## ------------- ## + # option to skip checks + if (!getOption("giotto.check_valid", TRUE)) { + return(.Object) + } - # spat_unit cross compatibility for metadata checks use spatIDs() to pull - # the relevant set of spatIDs for that spatial unit. + vmsg(.is_debug = TRUE, .initial = " ", "!!giotto validity run!!") - if (!is.null(avail_cm)) { - .check_cell_metadata(gobject = .Object) # modifies by reference - } + ## Metadata ## + ## ------------- ## - if (!is.null(avail_fm)) { - .check_feat_metadata(gobject = .Object) # modifies by reference - } + # spat_unit cross compatibility for metadata checks use spatIDs() to pull + # the relevant set of spatIDs for that spatial unit. + if (!is.null(avail_cm)) { + .check_cell_metadata(gobject = .Object) # modifies by reference + } - ## Spatial locations ## - ## ----------------- ## + if (!is.null(avail_fm)) { + .check_feat_metadata(gobject = .Object) # modifies by reference + } - if (!is.null(avail_expr) && !is.null(avail_sl)) { - # 1. ensure spatial locations and expression matrices have the same - # cell IDs - # 2. give cell IDs if not provided - .check_spatial_location_data(gobject = .Object) # modifies by reference - } + ## Spatial locations ## + ## ----------------- ## + if (!is.null(avail_expr) && !is.null(avail_sl)) { + # 1. ensure spatial locations and expression matrices have the same + # cell IDs + # 2. give cell IDs if not provided + .check_spatial_location_data(gobject = .Object) # modifies by reference + } - ## Spatial network ## - ## --------------- ## - if (!is.null(avail_sl) && !is.null(avail_sn)) { - # 1. ensure vertices have same IDs as seen in spat_unit for gobject - # 2. ensure spatial locations of same spat_unit exists - .check_spatial_networks(gobject = .Object) - } + ## Spatial network ## + ## --------------- ## + if (!is.null(avail_sl) && !is.null(avail_sn)) { + # 1. ensure vertices have same IDs as seen in spat_unit for gobject + # 2. ensure spatial locations of same spat_unit exists + .check_spatial_networks(gobject = .Object) + } - ## Spatial enrichment ## - ## ------------------ ## - if (!is.null(avail_sl) && !is.null(avail_se)) { - # 1. ensure IDs in enrichment match gobject for same spat_unit - # 2. ensure spatial locations exist for same spat_unit - .check_spatial_enrichment(gobject = .Object) - } + ## Spatial enrichment ## + ## ------------------ ## + if (!is.null(avail_sl) && !is.null(avail_se)) { + # 1. ensure IDs in enrichment match gobject for same spat_unit + # 2. ensure spatial locations exist for same spat_unit + .check_spatial_enrichment(gobject = .Object) + } - ## Nearest networks ## - ## ---------------- ## - if (!is.null(avail_expr) && !is.null(avail_nn)) { - .check_nearest_networks(gobject = .Object) - } + ## Nearest networks ## + ## ---------------- ## + if (!is.null(avail_expr) && !is.null(avail_nn)) { + .check_nearest_networks(gobject = .Object) + } - ## Dimension reduction ## - ## ------------------- ## - if (!is.null(avail_dr)) { - .Object <- .check_dimension_reduction(gobject = .Object) - } + ## Dimension reduction ## + ## ------------------- ## + if (!is.null(avail_dr)) { + .Object <- .check_dimension_reduction(gobject = .Object) + } - ## Spatial info ## - ## ------------ ## - if (!is.null(avail_si) & !is.null(avail_sl)) { - .check_spatial_info(gobject = .Object) - } + ## Spatial info ## + ## ------------ ## + if (!is.null(avail_si) & !is.null(avail_sl)) { + .check_spatial_info(gobject = .Object) + } - ## validity check ## - ## -------------- ## - methods::validObject(.Object) + ## validity check ## + ## -------------- ## + methods::validObject(.Object) - .Object -}) + .Object + } +) @@ -571,9 +584,9 @@ setMethod("initialize", "affine2d", function(.Object, ...) { .Object <- methods::callNextMethod() .Object@anchor <- ext(.Object@anchor) %>% .ext_to_num_vec() - + res <- .decomp_affine(.Object@affine) - + .Object@affine <- res$affine .Object@rotate <- res$rotate .Object@shear <- res$shear @@ -586,22 +599,24 @@ setMethod("initialize", "affine2d", function(.Object, ...) { ## giottoLargeImage #### setMethod("initialize", signature("giottoLargeImage"), function(.Object, ...) { .Object <- methods::callNextMethod() - + # defaults .Object@OS_platform <- .Object@OS_platform %null% .Platform[["OS.type"]] objName(.Object) <- objName(.Object) %null% "image" - + r <- .Object@raster_object - if (is.null(r)) return(.Object) # return early if NULL - + if (is.null(r)) { + return(.Object) + } # return early if NULL + # scale factor and res .Object@resolution <- terra::res(r) names(.Object@resolution) <- c("x", "y") .Object@scale_factor <- 1 / .Object@resolution - + # sample for image characteristics svals <- .spatraster_sample_values(r, size = 5000, verbose = FALSE) - + if (nrow(svals) != 0) { intensity_range <- .spatraster_intensity_range( raster_object = r, @@ -610,71 +625,71 @@ setMethod("initialize", signature("giottoLargeImage"), function(.Object, ...) { } .Object@min_intensity <- intensity_range[["min"]] .Object@max_intensity <- intensity_range[["max"]] - + # find out if image is int or floating pt is_int <- .spatraster_is_int( raster_object = r, sample_values = svals ) .Object@is_int <- is_int - + # extent .Object@extent <- as.vector(terra::ext(r)) names(.Object@extent) <- c("xmin", "xmax", "ymin", "ymax") .Object@overall_extent <- .Object@overall_extent %null% as.vector(terra::ext(r)) - + # max window .Object@max_window <- .Object@max_window %null% .Object@max_intensity - # .Object@max_window <- .Object@max_window %na% + # .Object@max_window <- .Object@max_window %na% # .bitdepth(.Object@max_intensity, return_max = TRUE) - + return(.Object) }) ## giottoAffineImage #### setMethod("initialize", signature("giottoAffineImage"), function(.Object, ...) { .Object <- methods::callNextMethod() - + # default name if (is.null(objName(.Object))) { objName(.Object) <- "test" } - + # append associated functions - - + + r <- .Object@raster_object if (!is.null(r)) { # apply the image extent as anchor for affine object plotting .Object@affine@anchor <- ext(r) .Object@affine <- initialize(.Object@affine) - + # compute & set extent slot as a numeric vector d <- .bound_poly(r) %>% affine(.Object@affine) .Object@extent <- .ext_to_num_vec(ext(d)) } - - .Object@funs$realize_magick <- function(tempname = "preview", size = 5e5) { + + .Object@funs$realize_magick <- function(filename = NULL, size = 5e5) { mg <- .gaffine_realize_magick(.Object, size = size) - gimg <- .magick_preview(mg@mg_object, tempname = tempname) %>% + gimg <- .magick_preview(mg@mg_object, filename = filename) %>% createGiottoLargeImage() ext(gimg) <- ext(.Object) - + # mask image aff <- .Object@affine m <- .bound_poly(ext(aff@anchor)) m <- affine(m, aff) gimg@raster_object <- terra::mask(gimg@raster_object, mask = m) - + return(gimg) # TODO things to be implemented for this pipeline: # col (the trip the magick-image flattened the image without applying col) # max_intensity same as above # the above options are also stripped when the fresh largeImage is created } - + return(.Object) }) @@ -849,8 +864,9 @@ init_cell_and_feat_IDs <- function(gobject) { #' and feature type in the giotto object. #' @returns cellMetaObjs #' @keywords internal -init_cell_metadata <- function(gobject, - provenance = NULL) { +init_cell_metadata <- function( + gobject, + provenance = NULL) { # data.table vars spat_unit <- feat_type <- NULL @@ -918,8 +934,9 @@ init_cell_metadata <- function(gobject, #' @param provenance provenance information (optional) #' @returns featMetaObjs #' @keywords internal -init_feat_metadata <- function(gobject, - provenance = NULL) { +init_feat_metadata <- function( + gobject, + provenance = NULL) { # data.table vars spat_unit <- feat_type <- NULL diff --git a/R/methods-instructions.R b/R/methods-instructions.R index 317bf89f..b1deafa1 100644 --- a/R/methods-instructions.R +++ b/R/methods-instructions.R @@ -6,51 +6,55 @@ NULL #' @title Giotto instructions #' @name giotto_instructions #' @aliases instructions instructions<- -#' @description +#' @description #' Giotto instructions are default settings that are applied at the `giotto` #' object level. Once added to an object, they affect the way that the object -#' behaves. You can create a `giottoInstructions` object using +#' behaves. You can create a `giottoInstructions` object using #' `createGiottoInstructions()` and add them to the `giotto` object during #' creation or using the `instructions()` generic. Specific settings can be #' replaced or retrieved using the `param` argument. Additionally, when using -#' `instructions<-()` as a replacement function, `initialize()` will be called +#' `instructions<-()` as a replacement function, `initialize()` will be called #' on the `giotto` object if `initialize = TRUE`. -#' -#' If no `giottoInstructions` object is provided during `giotto` object -#' creation, then a default one will be created during `giotto` object +#' +#' If no `giottoInstructions` object is provided during `giotto` object +#' creation, then a default one will be created during `giotto` object #' initialization. -#' +#' #' @inheritParams data_access_params #' @param param Specific param in instructions to access or modify #' @param initialize (boolean, default = TRUE) whether to initialize the giotto #' object #' @param value value to set +#' @param \dots params to pass to `createGiottoInstructions()` #' @returns `giottoInstructions`, instructions settings, or `giotto` objects #' with modified instructions #' @examples #' g <- GiottoData::loadGiottoMini("visium") #' +#' # create instructions +#' ins <- instructions() +#' #' # get instructions #' instrs <- instructions(g) #' force(instrs) -#' +#' #' # get single instructions param #' instructions(g, "show_plot") -#' -#' # replace single instruction param +#' +#' # replace an instruction param #' instructions(g, "show_plot") <- FALSE #' instructions(g, "show_plot") -#' +#' #' # replace multiple instruction params #' instructions(g) #' instructions(g, c("show_plot", "dpi")) <- list(TRUE, 600) #' instructions(g) -#' +#' #' # replace instructions #' i <- createGiottoInstructions() #' instructions(g) <- i #' instructions(g) -#' +#' NULL #' @title Active spatial unit @@ -84,6 +88,15 @@ NULL # instructions() method #### +# create instructions object +#' @rdname giotto_instructions +#' @export +setMethod( + "instructions", signature(gobject = "missing", param = "missing"), + function(...) createGiottoInstructions(...) +) + + # Get instructions object #' @rdname giotto_instructions #' @export @@ -94,6 +107,30 @@ setMethod( } ) + +# Get specific field +#' @rdname giotto_instructions +#' @export +setMethod( + "instructions", signature(gobject = "giotto", param = "character"), + function(gobject, param) { + instrs <- showGiottoInstructions(gobject = gobject) + return(readGiottoInstructions( + giotto_instructions = instrs, + param = param + )) + } +) + +#' @rdname giotto_instructions +#' @export +setMethod( + "instructions", + signature(gobject = "giottoInstructions", param = "character"), + function(gobject, param) gobject[[param]] +) + + # Set instructions object #' @rdname giotto_instructions #' @export @@ -128,19 +165,6 @@ setMethod( } ) -# Get specific field -#' @rdname giotto_instructions -#' @export -setMethod( - "instructions", signature(gobject = "giotto", param = "character"), - function(gobject, param) { - instrs <- showGiottoInstructions(gobject = gobject) - return(readGiottoInstructions( - giotto_instructions = instrs, - param = param - )) - } -) # Set specific field #' @rdname giotto_instructions @@ -181,7 +205,18 @@ setMethod( return(gobject) } ) - +#' @rdname giotto_instructions +#' @export +setMethod( + "instructions<-", + signature( + gobject = "giottoInstructions", param = "character", value = "ANY" + ), + function(gobject, param, value) { + gobject[[param]] <- value + return(gobject) + } +) diff --git a/R/methods-names.R b/R/methods-names.R index bbb9d7af..e565497f 100644 --- a/R/methods-names.R +++ b/R/methods-names.R @@ -1,12 +1,17 @@ #' @include generics.R NULL +# NOTE: +# dimnames MUST be provided for rownames and colnames methods to be well +# behaved + #' @title Row and column names #' @name row-plus-colnames-generic #' @aliases colnames rownames #' @description Retrieve or set the row or column names of an object #' @param x object #' @return A character vector of row or col names +#' @keywords internal #' @examples #' g <- GiottoData::loadSubObjectMini("exprObj") #' @@ -19,12 +24,17 @@ NULL #' Retrieve or set the dimnames of an object #' @param x object #' @returns character +#' @keywords internal #' @examples #' g <- GiottoData::loadSubObjectMini("exprObj") #' #' dimnames(g) NULL +#' @rdname row-plus-colnames-generic +#' @export +setMethod("colnames", signature("giotto"), function(x) x$cell_ID) + #' @rdname row-plus-colnames-generic #' @export setMethod("colnames", signature(x = "exprObj"), function(x) colnames(x[])) @@ -51,6 +61,11 @@ setMethod("colnames", signature(x = "dimObj"), function(x) colnames(x[])) +#' @rdname row-plus-colnames-generic +#' @export +setMethod("rownames", signature("giotto"), function(x) { + fDataDT(x)$feat_ID +}) #' @rdname row-plus-colnames-generic #' @export @@ -60,9 +75,17 @@ setMethod("rownames", signature(x = "exprObj"), function(x) rownames(x[])) #' @export setMethod("rownames", signature(x = "dimObj"), function(x) rownames(x[])) +#' @rdname row-plus-colnames-generic +#' @export +setMethod("rownames", signature(x = "metaData"), function(x) rownames(x[])) +#' @rdname dimnames +#' @export +setMethod("dimnames", signature("giotto"), function(x) { + list(rownames(x), colnames(x)) +}) #' @rdname dimnames #' @export @@ -71,3 +94,19 @@ setMethod("dimnames", signature(x = "exprObj"), function(x) dimnames(x[])) #' @rdname dimnames #' @export setMethod("dimnames", signature(x = "dimObj"), function(x) dimnames(x[])) + +#' @rdname dimnames +#' @export +setMethod("dimnames", signature(x = "spatLocsObj"), function(x) dimnames(x[])) + +#' @rdname dimnames +#' @export +setMethod("dimnames", signature(x = "metaData"), function(x) dimnames(x[])) + +#' @rdname dimnames +#' @export +setMethod("dimnames", signature(x = "enrData"), function(x) dimnames(x[])) + +#' @rdname dimnames +#' @export +setMethod("dimnames", signature(x = "dimObj"), function(x) dimnames(x[])) diff --git a/R/methods-nesting.R b/R/methods-nesting.R index 2d1e48a1..adcb0089 100644 --- a/R/methods-nesting.R +++ b/R/methods-nesting.R @@ -64,6 +64,13 @@ NULL # spatUnit #### +# default for unknown types +#' @describeIn spatUnit-generic Get spatial unit information +#' @export +setMethod("spatUnit", signature("ANY"), function(x) { + NA_character_ +}) + #' @rdname spatUnit-generic #' @export setMethod("spatUnit", signature("list"), function(x) { @@ -96,13 +103,34 @@ setMethod("spatUnit<-", signature("giottoPolygon"), function(x, value) { x }) - +#' @rdname spatUnit-generic +#' @export +setMethod("spatUnit<-", signature = "list", function(x, value) { + if (length(x) != length(value)) { + stop("Number of names to set must be the same as the length of list", + call. = FALSE + ) + } + lapply(seq_along(x), function(i) { + y <- x[[i]] + spatUnit(y) <- value[[i]] + return(y) + }) +}) # featType #### +# default for unknown types +#' @describeIn featType-generic Get feature type information +#' @export +setMethod("featType", signature("ANY"), function(x) { + NA_character_ +}) + + #' @rdname featType-generic #' @export setMethod("featType", signature("list"), function(x) { @@ -122,25 +150,43 @@ setMethod("featType<-", signature = "featData", function(x, value) { x }) - +#' @rdname featType-generic +#' @export +setMethod("featType<-", signature = "list", function(x, value) { + if (length(x) != length(value)) { + stop("Number of names to set must be the same as the length of list", + call. = FALSE + ) + } + lapply(seq_along(x), function(i) { + y <- x[[i]] + featType(y) <- value[[i]] + return(y) + }) +}) # objName #### +# default for unknown types +#' @rdname objName-generic +#' @export +setMethod("objName", signature("ANY"), function(x) NA_character_) + #' @rdname objName-generic #' @export -setMethod("objName", signature = "list", function(x) { +setMethod("objName", signature("list"), function(x) { vapply(x, objName, FUN.VALUE = character(1L), USE.NAMES = FALSE) }) #' @describeIn objName-generic Get name information #' @export -setMethod("objName", signature = "nameData", function(x) x@name) +setMethod("objName", signature("nameData"), function(x) x@name) #' @describeIn objName-generic Get name giottoPoints #' @export -setMethod("objName", signature = "giottoPoints", function(x) x@feat_type) +setMethod("objName", signature("giottoPoints"), function(x) x@feat_type) #' @rdname objName-generic #' @export @@ -155,7 +201,8 @@ setMethod("objName", signature("giottoImage"), function(x) x@name) setMethod("objName<-", signature = "list", function(x, value) { if (length(x) != length(value)) { stop("Number of names to set must be the same as the length of list", - call. = FALSE) + call. = FALSE + ) } lapply(seq_along(x), function(i) { y <- x[[i]] @@ -252,6 +299,7 @@ NULL #' @param force_replace logical. default = FALSE. Whether to replace the #' names of objects for which the name already has a name for #' @keywords internal +#' @returns list assign_objnames_2_list <- function(obj_list, force_replace = FALSE) { if (is.null(obj_list)) { return(obj_list) @@ -292,7 +340,8 @@ assign_listnames_2_obj <- function(obj_list) { stop(" List has no names\n") } obj_index <- which(vapply( - obj_list, inherits, "nameData", FUN.VALUE = logical(1L) + obj_list, inherits, "nameData", + FUN.VALUE = logical(1L) )) list_obj_names <- list_names[obj_index] diff --git a/R/methods-plot.R b/R/methods-plot.R index e3e540a6..1ccb2fd2 100644 --- a/R/methods-plot.R +++ b/R/methods-plot.R @@ -18,12 +18,14 @@ NULL - +# * giottoImage #### #' @describeIn plot-generic Plot \emph{magick}-based giottoImage object. ... param passes to \code{\link{.plot_giottoimage_mg}} #' @export setMethod("plot", signature(x = "giottoImage", y = "missing"), function(x, y, ...) .plot_giottoimage_mg(giottoImage = x, ...)) +# * giottoLargeImage #### + #' @describeIn plot-generic Plot \emph{terra}-based giottoLargeImage object. ... param passes to \code{\link{.plot_giottolargeimage}} #' @param col character. Colors. The default is grDevices::grey.colors(n = 256, start = 0, end = 1, gamma = 1) #' @param max_intensity (optional) value to treat as maximum intensity in color scale @@ -47,8 +49,9 @@ setMethod("plot", signature(x = "giottoImage", y = "missing"), function(x, y, .. setMethod( "plot", signature(x = "giottoLargeImage", y = "missing"), - function(x, y, col, max_intensity, mar, asRGB = FALSE, legend = FALSE, axes = TRUE, - maxcell = 5e5, smooth = TRUE, ...) { + function( + x, y, col, max_intensity, mar, asRGB = FALSE, legend = FALSE, axes = TRUE, + maxcell = 5e5, smooth = TRUE, ...) { arglist <- list( giottoLargeImage = x, asRGB = asRGB, @@ -86,12 +89,18 @@ setMethod( } ) +# * giottoAffineImage #### + #' @rdname plot-generic #' @export -setMethod("plot", signature(x = "giottoAffineImage", y = "missing"), - function(x, ...) { - .plot_giottoaffineimage(x, ...) - }) +setMethod( + "plot", signature(x = "giottoAffineImage", y = "missing"), + function(x, ...) { + .plot_giottoaffineimage(x, ...) + } +) + +# * giottoPolygon #### #' @describeIn plot-generic Plot \emph{terra}-based giottoPolygon object. ... param passes to \code{\link[terra]{plot}} #' @param point_size size of points when plotting giottoPolygon object centroids @@ -108,12 +117,11 @@ setMethod("plot", signature(x = "giottoAffineImage", y = "missing"), #' @export setMethod( "plot", signature(x = "giottoPolygon", y = "missing"), - function( - x, - point_size = 0.6, - type = c("poly", "centroid"), - max_poly = getOption("giotto.plot_max_poly", 1e6), - ...) { + function(x, + point_size = 0.6, + type = c("poly", "centroid"), + max_poly = getOption("giotto.plot_max_poly", 1e6), + ...) { if (length(x@unique_ID_cache) == 0) { stop(wrap_txt("No geometries to plot"), call. = FALSE) } @@ -128,6 +136,8 @@ setMethod( } ) +# * giottoPoints #### + #' @describeIn plot-generic \emph{terra}-based giottoPoint object. ... param passes to \code{\link[terra]{plot}} #' @param point_size size of points when plotting giottoPoints #' @param feats specific features to plot within giottoPoints object @@ -154,7 +164,7 @@ setMethod( #' "black" and "white" are used. #' * **background** (optional) background color. Usually not used when a #' `col` color mapping is sufficient. -#' +#' #' Note that `col` param and other [base::plot()] graphical params are available #' through `...` #' @examples @@ -202,6 +212,7 @@ setMethod( } ) +# * spatLocsObj #### #' @describeIn plot-generic Plot a spatLocsObj #' @examples @@ -224,6 +235,7 @@ setMethod("plot", signature(x = "spatLocsObj", y = "missing"), function(x, ...) } }) +# * dimObj #### #' @describeIn plot-generic Plot a dimObj #' @param dims dimensions to plot @@ -254,6 +266,7 @@ setMethod( } ) +# * spatialNetworkObj #### #' @describeIn plot-generic Plot a spatialNetworkObj #' @export @@ -290,13 +303,14 @@ setMethod("plot", signature(x = "spatialNetworkObj", y = "missing"), function(x, if (is.null(l$pch)) l$pch <- "." } do.call("plot", append(l, list(x = nodes$sdimx_begin, y = nodes$sdimy_begin))) - segments( + graphics::segments( x0 = x[]$sdimx_begin, y0 = x[]$sdimy_begin, x1 = x[]$sdimx_end, y1 = x[]$sdimy_end, col = line_col, lty = line_type, lwd = line_width ) }) +# * affine2d #### #' @describeIn plot-generic Plot a affine2d. blue is start, red is end #' @export @@ -416,9 +430,10 @@ setMethod("plot", signature(x = "affine2d", y = "missing"), function(x, ...) { #' @param giottoImage giottoImage object #' @return plot #' @keywords internal -.plot_giottoimage_mg <- function(gobject = NULL, - image_name = NULL, - giottoImage = NULL) { +.plot_giottoimage_mg <- function( + gobject = NULL, + image_name = NULL, + giottoImage = NULL) { if (!is.null(giottoImage)) { graphics::plot(giottoImage@mg_object) } else { @@ -464,25 +479,26 @@ setMethod("plot", signature(x = "affine2d", y = "missing"), function(x, ...) { #' depending on image type #' @return plot #' @keywords internal -.plot_giottolargeimage <- function(gobject = NULL, - largeImage_name = NULL, - giottoLargeImage = NULL, - crop_extent = NULL, - xmax_crop = NULL, - xmin_crop = NULL, - ymax_crop = NULL, - ymin_crop = NULL, - max_intensity = NULL, - asRGB = FALSE, - stretch = NULL, - axes = TRUE, - smooth = TRUE, - mar = c(3, 5, 1.5, 1), - legend = FALSE, - maxcell = 5e5, - col = grDevices::grey.colors(n = 256, start = 0, end = 1, gamma = 1), - asp = 1, - ...) { +.plot_giottolargeimage <- function( + gobject = NULL, + largeImage_name = NULL, + giottoLargeImage = NULL, + crop_extent = NULL, + xmax_crop = NULL, + xmin_crop = NULL, + ymax_crop = NULL, + ymin_crop = NULL, + max_intensity = NULL, + asRGB = FALSE, + stretch = NULL, + axes = TRUE, + smooth = TRUE, + mar = c(3, 5, 1.5, 1), + legend = FALSE, + maxcell = 5e5, + col = grDevices::grey.colors(n = 256, start = 0, end = 1, gamma = 1), + asp = 1, + ...) { a <- c(get_args_list(), list(...)) # Get giottoLargeImage and check and perform crop if needed @@ -561,12 +577,13 @@ setMethod("plot", signature(x = "affine2d", y = "missing"), function(x, ...) { #' @param ... additional params to pass to plot functions #' @keywords internal #' @noRd -.plot_giotto_points <- function(x, - point_size = 0, - feats = NULL, - raster = TRUE, - raster_size = 600L, - ...) { +.plot_giotto_points <- function( + x, + point_size = 0, + feats = NULL, + raster = TRUE, + raster_size = 600L, + ...) { args_list <- list(feats, asp = 1L, ...) # point size @@ -768,8 +785,7 @@ setMethod("plot", signature(x = "affine2d", y = "missing"), function(x, ...) { feat_ID, function(feat_i) which(feats == feat_i), FUN.VALUE = integer(1L) - ) - ] + )] args_list$x <- dataDT$x args_list$y <- dataDT$y @@ -783,7 +799,7 @@ setMethod("plot", signature(x = "affine2d", y = "missing"), function(x, ...) { do.call(scattermore::scattermoreplot, args_list) legend( x = "topright", - inset = c(-1.3 / dev.size()[1], 0), + inset = c(-1.3 / grDevices::dev.size()[1], 0), legend = feats, col = feat_colors, bty = "n", @@ -842,9 +858,8 @@ setMethod("plot", signature(x = "affine2d", y = "missing"), function(x, ...) { #' @param ... additional params to pass to plot function #' @keywords internal #' @noRd -.plot_giotto_polygon <- function( - x, point_size = 0.6, - type = c("poly", "centroid"), ...) { +.plot_giotto_polygon <- function(x, point_size = 0.6, + type = c("poly", "centroid"), ...) { a <- list(...) type <- match.arg(type, choices = c("poly", "centroid")) diff --git a/R/methods-rbind.R b/R/methods-rbind.R index a3b2c71f..d31a47d7 100644 --- a/R/methods-rbind.R +++ b/R/methods-rbind.R @@ -1,7 +1,7 @@ #' @include generics.R NULL -# NOTE: +# NOTE: # rbind2 methods will only work if the object already has nrow and dim # generics defined. @@ -25,15 +25,35 @@ NULL #' @rdname rbind-generic #' @export setMethod( - "rbind2", signature(x = "spatLocsObj", y = "spatLocsObj"), + "rbind2", signature(x = "cellMetaObj", y = "cellMetaObj"), function(x, y, ...) { + .check_id_dups(x, y, type = "spat") + + x[] <- rbind(x[], y[], fill = TRUE) + return(x) + } +) +#' @rdname rbind-generic +#' @export +setMethod( + "rbind2", signature(x = "featMetaObj", y = "featMetaObj"), + function(x, y, ...) { + .check_id_dups(x, y, type = "feat") + + x[] <- rbind(x[], y[], fill = TRUE) + return(x) + } +) + +#' @rdname rbind-generic +#' @export +setMethod( + "rbind2", signature(x = "spatLocsObj", y = "spatLocsObj"), + function(x, y, ...) { # catch same IDs - if (any(duplicated(c(spatIDs(x), spatIDs(y))))) { - stop("rbind: `spatLocsObj` with the same IDs cannot be joined", - call. = FALSE) - } - + .check_id_dups(x, y, type = "spat") + # if one is 3d, ensure both are 3d x3 <- .is_3d_spatlocs(x) y3 <- .is_3d_spatlocs(y) @@ -41,7 +61,7 @@ setMethod( if (!x3) x <- .make_spatlocs_3d(x) if (!y3) y <- .make_spatlocs_3d(y) } - + x[] <- rbind(x[], y[]) return(x) } @@ -71,6 +91,7 @@ setMethod( ) + if (!isGeneric("rbind")) setGeneric("rbind", signature = "...") setMethod("rbind", "giottoPolygon", function(..., deparse.level = 1) { @@ -94,9 +115,22 @@ setMethod("rbind", "spatLocsObj", function(..., deparse.level = 1) { - # internals #### +.check_id_dups <- function(x, y, type = c("spat", "feat")) { + type <- match.arg(type, choices = c("spat", "feat")) + .id <- switch(type, + "spat" = spatIDs, + "feat" = featIDs + ) + + if (any(duplicated(c(.id(x), .id(y))))) { + stop(sprintf("rbind: `%s` with the same IDs cannot be joined", class(x)), + call. = FALSE + ) + } +} + .is_3d_spatlocs <- function(x) { "sdimz" %in% colnames(x) } diff --git a/R/methods-reconnect.R b/R/methods-reconnect.R index b7720f14..1c20887d 100644 --- a/R/methods-reconnect.R +++ b/R/methods-reconnect.R @@ -6,18 +6,41 @@ #' has changed. #' @param ... additional params to pass #' @returns GiottoClass object +#' @examples +#' f <- tempfile() +#' a <- GiottoData::loadSubObjectMini("giottoLargeImage") +#' saveRDS(a, f) +#' +#' b <- readRDS(f) # expected to be null pointer +#' b <- reconnect(b) # reconnected to source image NULL +#' @rdname reconnect +#' @export +setMethod("reconnect", signature("giottoAffineImage"), function(x, path = NULL, ...) { + path <- path %null% slot(x, "file_path") + .image_path_checks(path) + + # replace old raster objects + raster_object <- .create_terra_spatraster(image_path = path) + slot(x, "raster_object") <- raster_object + + # inherit tracked extents (image extent and user-facing extent) + img_ext <- x@affine@anchor + user_ext <- x@extent + + # this method affects multiple slots, including the extent of the image, so do first + ext(x) <- user_ext + # this only affects the image extent, so do second + ext(x@raster_object) <- img_ext + + return(initialize(x)) +}) #' @rdname reconnect -#' @examples -#' g <- GiottoData::loadGiottoMini("visium") -#' g_image <- getGiottoImage(g, image_type = "largeImage") -#' -#' reconnect(g_image) #' @export setMethod("reconnect", signature("giottoLargeImage"), function(x, path = NULL, ...) { path <- path %null% slot(x, "file_path") @@ -26,9 +49,9 @@ setMethod("reconnect", signature("giottoLargeImage"), function(x, path = NULL, . # replace old raster objects and inherit tracked extents raster_object <- .create_terra_spatraster(image_path = path) slot(x, "raster_object") <- raster_object - terra::ext(slot(x, "raster_object")) <- slot(x, "extent") + ext(slot(x, "raster_object")) <- slot(x, "extent") - return(x) + return(initialize(x)) }) diff --git a/R/methods-relate.R b/R/methods-relate.R new file mode 100644 index 00000000..91219a1a --- /dev/null +++ b/R/methods-relate.R @@ -0,0 +1,138 @@ +# docs ----------------------------------------------------------- # +#' @title Spatial relationships between geometries +#' @name relate +#' @description `relate()` returns a logical matrix indicating the presence or +#' absence of a specific spatial relationships between the geometries in +#' x and y. +#' @param x spatial object with records to test +#' @param y spatial object records to test relations against +#' @param ... additional args to pass +#' @param output character. `"data.table"` or `"matrix"`. `"data.table"` is +#' only possible when `pairs=TRUE` +#' @param use_names logical. If `TRUE`, `pairs=TRUE`, and `output="data.table"` +#' the IDs of the geometries will be used. +#' @returns `data.table` if `output="data.table"`. `matrix` if `output="matrix"` +#' @examples +#' g <- GiottoData::loadGiottoMini("viz") +#' activeSpatUnit(g) <- "aggregate" +#' sl <- g[["spatial_locs"]][[1]] +#' gpoints <- g[["feat_info"]][[1]] +#' gpoly <- g[["spatial_info"]][[1]] +#' +#' res1 <- relate(gpoints, gpoly, relation = "intersects") +#' res2 <- relate(gpoints, gpoly, relation = "intersects", use_names = FALSE) +#' +#' selection <- system.file("extdata/viz_interactive_select.csv", +#' package = "GiottoClass" +#' ) +#' select_polys <- createGiottoPolygon(data.table::fread(selection)) +#' res <- relate(g, select_polys, relation = "intersects") +#' g[, res[y == "polygon1", x]] +#' g[, res[y == "polygon2", x]] +#' g[, res[y == "polygon3", x]] +NULL +# ---------------------------------------------------------------- # + +#' @rdname relate +#' @inheritParams terra::relate +#' @export +setMethod( + "relate", signature(x = "giottoSpatial", y = "giottoSpatial"), + function(x, y, relation, + pairs = TRUE, + na.rm = TRUE, + output = c("data.table", "matrix"), + use_names = TRUE, + ...) { + output <- match.arg(output, choices = c("data.table", "matrix")) + + if (inherits(x, "spatLocsObj")) x_use <- as.points(x) + if (inherits(y, "spatLocsObj")) y_use <- as.points(y) + if (inherits(x, "giottoSpatial")) x_use <- x[] + if (inherits(x, "giottoSpatial")) y_use <- y[] + + res <- relate(x_use, y_use, relation, pairs, na.rm, ...) + + if (pairs && output == "data.table") { + res <- data.table::as.data.table(res) + data.table::setnames(res, new = c("x", "y")) + + if (use_names) { + x_ids <- .get_ids(x, res$x) + y_ids <- .get_ids(y, res$y) + res[, x := x_ids] + res[, y := y_ids] + } + } + + return(res) + } +) + +#' @rdname relate +#' @param what character. Which type of spatial data in the `giotto` object to +#' relate. One of "polygon", "spatlocs", "points" +#' @param spat_unit spatial unit +#' @param feat_type feature type +#' @param spat_locs_name name of spatlocs to use if what = "spatlocs" +#' @export +setMethod( + "relate", signature(x = "giotto", y = "giottoSpatial"), + function(x, y, ..., + what = c("polygon", "spatlocs", "points"), + spat_unit = NULL, + feat_type = NULL, + spat_locs_name = NULL) { + what <- match.arg(what, c("polygon", "spatlocs", "points")) + + spat_unit <- set_default_spat_unit(x, spat_unit = spat_unit) + feat_type <- set_default_feat_type( + x, + spat_unit = spat_unit, feat_type = feat_type + ) + + x <- switch(what, + "polygon" = { + getPolygonInfo(x, + polygon_name = spat_unit, + return_giottoPolygon = TRUE + ) + }, + "points" = { + getFeatureInfo(x, + feat_type = feat_type, + return_giottoPoints = TRUE + ) + }, + "spatlocs" = { + getSpatialLocations(x, + spat_unit = spat_unit, + output = "spatLocsObj", + name = spat_locs_name + ) + } + ) + + res <- relate(x, y, ...) + return(res) + } +) + + + + + + +# internals #### + +.get_ids <- function(x, idx) { + ids <- x[idx]$cell_ID + ids <- ids %null% x[idx]$feat_ID + ids <- ids %null% x[idx]$poly_ID + if (is.null(ids)) { + stop("no ids found for an object. `use_names` might not work", + call. = FALSE + ) + } + return(ids) +} diff --git a/R/methods-rescale.R b/R/methods-rescale.R index 553a5dbb..f742b6a5 100644 --- a/R/methods-rescale.R +++ b/R/methods-rescale.R @@ -34,8 +34,7 @@ NULL setMethod( "rescale", signature("giotto"), function(x, fx = 1, fy = fx, x0, y0, spat_unit = ":all:", - feat_type = ":all:", images = ":all:" - ) { + feat_type = ":all:", images = ":all:") { # scalefactor settings a <- list(fx = fx, fy = fy) @@ -138,7 +137,7 @@ setMethod( imgs <- getGiottoImage(x, name = images) if (!is.null(imgs)) { if (!inherits(imgs, "list")) imgs <- list(imgs) - for(img in imgs) { + for (img in imgs) { img <- do.call(rescale, args = c(list(x = img), a)) x <- setGiottoImage(x, img, verbose = FALSE) } @@ -168,8 +167,9 @@ setMethod( #' columns. Default is `c("sdimx", "sdimy", "sdimz")` setMethod( "rescale", signature("data.frame"), - function(x, fx = 1, fy = fx, fz = fx, x0, y0, z0, - geom = c("sdimx", "sdimy", "sdimz")) { + function( + x, fx = 1, fy = fx, fz = fx, x0, y0, z0, + geom = c("sdimx", "sdimy", "sdimz")) { x <- data.table::as.data.table(x) # find center @@ -243,21 +243,23 @@ setMethod("rescale", signature("giottoLargeImage"), function(x, fx = 1, fy = fx, #' @rdname rescale #' @export -setMethod("rescale", signature("giottoAffineImage"), - function(x, fx = 1, fy = fx, x0, y0) { - a <- get_args_list() - a$x <- x@affine - # update affine - x@affine <- do.call(rescale, args = a) - - return(initialize(x)) -}) +setMethod( + "rescale", signature("giottoAffineImage"), + function(x, fx = 1, fy = fx, x0, y0) { + a <- get_args_list() + a$x <- x@affine + # update affine + x@affine <- do.call(rescale, args = a) + + return(initialize(x)) + } +) #' @rdname rescale #' @export setMethod("rescale", signature("affine2d"), function(x, fx = 1, fy = fx, x0, y0) { a <- get_args_list() - + # update linear scale_m <- diag(c(fx, fy)) old_aff <- new_aff <- x@affine @@ -270,19 +272,19 @@ setMethod("rescale", signature("affine2d"), function(x, fx = 1, fy = fx, x0, y0) a$x <- affine(d, old_aff) # perform new transform post <- do.call(rescale, args = a) - + # perform affine & transform without shifts b <- a b$x0 <- b$y0 <- 0 b$x <- affine(d, .aff_linear_2d(old_aff)) pre <- do.call(rescale, args = b) - + # find xyshift by comparing tfs so far vs new tf xyshift <- .get_centroid_xy(post) - .get_centroid_xy(pre) - + # update translate .aff_shift_2d(new_aff) <- xyshift - + x@affine <- new_aff return(initialize(x)) }) @@ -317,10 +319,11 @@ setMethod("rescale", signature("affine2d"), function(x, fx = 1, fy = fx, x0, y0) #' be applied to x, y, and z (if available) dimensions or as a vector of named #' values for 'x', y', (and 'z'). #' @keywords internal -.scale_spatial_locations <- function(spatlocs, - scale_factor = c(1, 1, 1), - scenter = c(0, 0, 0), - geom = c("sdimx", "sdimy", "sdimz")) { +.scale_spatial_locations <- function( + spatlocs, + scale_factor = c(1, 1, 1), + scenter = c(0, 0, 0), + geom = c("sdimx", "sdimy", "sdimz")) { checkmate::assert_data_table(spatlocs) xyz <- c("x", "y", "z") @@ -378,9 +381,10 @@ setMethod("rescale", signature("affine2d"), function(x, fx = 1, fy = fx, x0, y0) #' @returns polygons #' @description rescale individual polygons by a factor x and y #' @keywords internal -.rescale_polygons <- function(spatVector, - spatVectorCentroids, - fx = 0.5, fy = 0.5) { +.rescale_polygons <- function( + spatVector, + spatVectorCentroids, + fx = 0.5, fy = 0.5) { # DT vars poly_ID <- NULL @@ -423,13 +427,14 @@ setMethod("rescale", signature("affine2d"), function(x, fx = 1, fy = fx, x0, y0) #' #' rescalePolygons(g, poly_info = "aggregate") #' @export -rescalePolygons <- function(gobject, - poly_info = "cell", - name = "rescaled_cell", - fx = 0.5, - fy = 0.5, - calculate_centroids = TRUE, - return_gobject = TRUE) { +rescalePolygons <- function( + gobject, + poly_info = "cell", + name = "rescaled_cell", + fx = 0.5, + fy = 0.5, + calculate_centroids = TRUE, + return_gobject = TRUE) { # 1. get polygon information original <- get_polygon_info( gobject = gobject, diff --git a/R/methods-setGiotto.R b/R/methods-setGiotto.R index 5611e168..8cb3e4d3 100644 --- a/R/methods-setGiotto.R +++ b/R/methods-setGiotto.R @@ -4,6 +4,7 @@ #' @param x giottoSubobject to set #' @param verbose be verbose #' @param \dots additional params to pass to specific Giotto setter functions +#' @family functions to set data in giotto object #' @returns giottoSubobject #' @examples #' g <- createGiottoObject() @@ -21,9 +22,28 @@ NULL setMethod( "setGiotto", signature("giotto", "list"), function(gobject, x, verbose = TRUE, ...) { + # suspend init and checking until all items are added + a <- list(...) + init <- !isFALSE(a$initialize) + + init_opt <- getOption("giotto.init", TRUE) + cv_opt <- getOption("giotto.check_valid", TRUE) + + .reset_opts <- function() { + options("giotto.init" = init_opt) + options("giotto.check_valid" = cv_opt) + } + + on.exit(.reset_opts, add = TRUE) + options("giotto.init" = FALSE) + options("giotto.check_valid" = FALSE) + for (item in x) { gobject <- setGiotto(gobject, item, verbose = verbose, ...) } + + .reset_opts() + if (init) gobject <- initialize(gobject) return(gobject) } ) diff --git a/R/methods-shear.R b/R/methods-shear.R index 25dbe1d2..5a637782 100644 --- a/R/methods-shear.R +++ b/R/methods-shear.R @@ -17,9 +17,9 @@ #' @returns shear transformed object #' @examples #' sl <- GiottoData::loadSubObjectMini("spatLocsObj") -#' +#' #' plot(shear(sl, fx = 2)) -#' +#' #' # equivalent affine transform #' shear_m <- diag(rep(1, 3)) #' shear_m[2, 1] <- 2 @@ -31,9 +31,7 @@ NULL # * spatLocsObj #### #' @rdname shear #' @export -setMethod("shear", signature("spatLocsObj"), function( - x, fx = 0, fy = 0, x0, y0, ... -) { +setMethod("shear", signature("spatLocsObj"), function(x, fx = 0, fy = 0, x0, y0, ...) { a <- get_args_list(...) a$x <- x[] x[] <- do.call(.shear_dt, args = a) @@ -43,9 +41,7 @@ setMethod("shear", signature("spatLocsObj"), function( # * SpatVector #### #' @rdname shear #' @export -setMethod("shear", signature("SpatVector"), function( - x, fx = 0, fy = 0, x0, y0, ... -) { +setMethod("shear", signature("SpatVector"), function(x, fx = 0, fy = 0, x0, y0, ...) { a <- get_args_list(...) do.call(.shear_sv, args = a) }) @@ -53,9 +49,7 @@ setMethod("shear", signature("SpatVector"), function( # * giottoPoints #### #' @rdname shear #' @export -setMethod("shear", signature("giottoPoints"), function( - x, fx = 0, fy = 0, x0, y0, ... -) { +setMethod("shear", signature("giottoPoints"), function(x, fx = 0, fy = 0, x0, y0, ...) { a <- get_args_list(...) a$x <- x[] res <- do.call(.shear_sv, args = a) @@ -66,9 +60,7 @@ setMethod("shear", signature("giottoPoints"), function( # * giottoPolygon #### #' @rdname shear #' @export -setMethod("shear", signature("giottoPolygon"), function( - x, fx = 0, fy = 0, x0, y0, ... -) { +setMethod("shear", signature("giottoPolygon"), function(x, fx = 0, fy = 0, x0, y0, ...) { a <- get_args_list(...) a$x <- NULL .do_gpoly(x, what = .shear_sv, args = a) @@ -77,9 +69,7 @@ setMethod("shear", signature("giottoPolygon"), function( # * giottoLargeImage #### #' @rdname shear #' @export -setMethod("shear", signature("giottoLargeImage"), function( - x, fx = 0, fy = 0, x0, y0, ... -) { +setMethod("shear", signature("giottoLargeImage"), function(x, fx = 0, fy = 0, x0, y0, ...) { a <- get_args_list(...) a$x <- as(x, "giottoAffineImage") # convert to giottoAffineImage res <- do.call(shear, args = a) @@ -89,31 +79,27 @@ setMethod("shear", signature("giottoLargeImage"), function( # * giottoAffineImage #### #' @rdname shear #' @export -setMethod("shear", signature("giottoAffineImage"), function( - x, fx = 0, fy = 0, x0, y0, ... -) { +setMethod("shear", signature("giottoAffineImage"), function(x, fx = 0, fy = 0, x0, y0, ...) { a <- get_args_list(...) a$x <- x@affine # update affine x@affine <- do.call(shear, args = a) - + return(initialize(x)) }) # * affine2d #### #' @rdname shear #' @export -setMethod("shear", signature("affine2d"), function( - x, fx = 0, fy = 0, x0, y0, ... - ) { +setMethod("shear", signature("affine2d"), function(x, fx = 0, fy = 0, x0, y0, ...) { a <- get_args_list(...) - + # update linear shear_x <- matrix(c(1, fx, 0, 1), ncol = 2) shear_y <- matrix(c(1, 0, fy, 1), ncol = 2) old_aff <- new_aff <- x@affine .aff_linear_2d(new_aff) <- .aff_linear_2d(new_aff) %*% shear_x %*% shear_y - + ## calc shifts ## # create dummy d <- .bound_poly(x@anchor) @@ -121,19 +107,19 @@ setMethod("shear", signature("affine2d"), function( a$x <- affine(d, old_aff) # perform new transform post <- do.call(shear, args = a) - + # perform affine & transform without shifts b <- a b$x0 <- b$y0 <- 0 b$x <- affine(d, .aff_linear_2d(old_aff)) pre <- do.call(shear, args = b) - + # find xyshift by comparing tfs so far vs new tf xyshift <- .get_centroid_xy(post) - .get_centroid_xy(pre) - + # update translate .aff_shift_2d(new_aff) <- xyshift - + x@affine <- new_aff return(initialize(x)) }) @@ -142,9 +128,7 @@ setMethod("shear", signature("affine2d"), function( # internals #### -.shear_dt <- function( - x, fx = 0, fy = 0, x0, y0, geom = c("sdimx", "sdimy", "sdimz"), ... -) { +.shear_dt <- function(x, fx = 0, fy = 0, x0, y0, geom = c("sdimx", "sdimy", "sdimz"), ...) { x <- data.table::copy(x) xyz <- tail(letters, 3L) if (is.null(names(geom))) names(geom) <- xyz @@ -155,12 +139,12 @@ setMethod("shear", signature("affine2d"), function( if (missing(x0)) x0 <- x[, mean(range(get(geom_col[["x"]])))] if (missing(y0)) y0 <- x[, mean(range(get(geom_col[["y"]])))] scenter <- c(x0, y0) - + if (!all(scenter == c(0, 0))) { # center values x <- spatShift(x, dx = -x0, dy = -y0, geom = geom) } - + # perform shears if (fx != 0) { x[, (geom[["x"]]) := get(geom_col[["y"]]) * fx + get(geom_col[["x"]])] @@ -168,28 +152,25 @@ setMethod("shear", signature("affine2d"), function( if (fy != 0) { x[, (geom[["y"]]) := get(geom_col[["x"]]) * fy + get(geom_col[["y"]])] } - + if (!all(scenter == c(0, 0))) { # return values to original positions x <- spatShift(x, dx = x0, dy = y0, geom = geom) } - + return(x) } -.shear_sv <- function( - x, fx = 0, fy = 0, x0, y0, geom = tail(letters, 3L), ... -) { +.shear_sv <- function(x, fx = 0, fy = 0, x0, y0, geom = tail(letters, 3L), ...) { a <- get_args_list(...) gtype <- terra::geomtype(x) a$x <- data.table::as.data.table(x, geom = "XY") res <- do.call(.shear_dt, args = a) - + res <- switch(gtype, "points" = terra::vect(res, geom = c("x", "y")), "polygons" = terra::as.polygons(res) ) - + return(res) } - diff --git a/R/methods-show.R b/R/methods-show.R index ffd861b5..30072419 100644 --- a/R/methods-show.R +++ b/R/methods-show.R @@ -7,10 +7,11 @@ NULL #' Create a text representation of an object #' @param x object #' @param ... additional params to pass (none implemented) +#' @returns character #' @examples #' img <- GiottoData::loadSubObjectMini("giottoLargeImage") #' as.character(img) -#' +#' NULL #' @name show @@ -40,8 +41,9 @@ setMethod( cat("An object of class", class(object), "\n") - # active spat_unit and feat_type + nspat <- NULL + nfeat <- NULL active_su <- try(instructions(object, "active_spat_unit"), silent = TRUE ) @@ -50,9 +52,19 @@ setMethod( ) if (!inherits(active_su, "try-error")) { cat(">Active spat_unit: ", active_su, "\n") + nspat <- length(spatIDs(object, spat_unit = active_su)) } if (!inherits(active_ft, "try-error")) { cat(">Active feat_type: ", active_ft, "\n") + nfeat <- length(featIDs(object, feat_type = active_ft)) + } + + if (!is.null(nspat) || !is.null(nfeat)) { + cat(sprintf( + "dimensions : %d, %d (features, cells)\n", + nfeat %null% NA_integer_, + nspat %null% NA_integer_ + )) } @@ -241,6 +253,7 @@ setMethod("show", signature("cellMetaObj"), function(object) { cat("An object of class", class(object), "\n") .show_spat_and_feat(object) .show_prov(object) + .show_dim(object) cat("\n") if (!is.null(object[])) print(head(object[], 3L)) }) @@ -358,17 +371,17 @@ setMethod("show", signature("spatLocsObj"), function(object) { .show_class_and_name(object) .show_spat(object) .show_prov(object) - cat("dimensions:", dim(object), '\npreview :\n') - + cat("dimensions:", dim(object), "\npreview :\n") + if (!is.null(slot(object, "coordinates"))) { show(head(slot(object, "coordinates"), 3L)) } - + # print ranges if possible cat("\nranges:\n") col_names <- colnames(slot(object, "coordinates")) coord_cols <- col_names[col_names %in% c("sdimx", "sdimy", "sdimz")] - + try( expr = print(vapply( slot(object, "coordinates")[, c(coord_cols), with = FALSE], @@ -618,6 +631,7 @@ setMethod( ## giottoPoints #### #' @rdname show +#' @returns giotto slot setMethod("show", signature = "giottoPoints", function(object) { cat("An object of class giottoPoints\n") .show_feat(object) @@ -792,7 +806,7 @@ setMethod("show", signature("affine2d"), function(object) { paste(x, collapse = ", ") %>% paste(" (x, y)") } - + showlist <- list() showlist$anchor <- .anchor_print() for (tf in object@order) { @@ -852,6 +866,12 @@ setMethod("as.character", signature("giottoLargeImage"), function(x, ...) { } } +#' @noRd +.show_dim <- function(object) { + d <- dim(object) + cat(sprintf("dimensions: %d %d \n", d[1], d[2])) +} + #' @noRd .show_ext <- function(object) { paste0( diff --git a/R/methods-spatShift.R b/R/methods-spatShift.R index 25a0ca77..f630a0a9 100644 --- a/R/methods-spatShift.R +++ b/R/methods-spatShift.R @@ -32,10 +32,8 @@ NULL setMethod( "spatShift", signature = "giotto", - function( - x, dx = 0, dy = 0, - spat_unit = ":all:", feat_type = ":all:", images = ":all:" - ) { + function(x, dx = 0, dy = 0, + spat_unit = ":all:", feat_type = ":all:", images = ":all:") { a <- list(dx = dx, dy = dy) spat_unit <- set_default_spat_unit( @@ -115,7 +113,7 @@ setMethod( imgs <- getGiottoImage(x, name = images) if (!is.null(imgs)) { if (!inherits(imgs, "list")) imgs <- list(imgs) - for(img in imgs) { + for (img in imgs) { img <- do.call(spatShift, args = c(list(x = img), a)) x <- setGiottoImage(x, img, verbose = FALSE) } @@ -127,10 +125,12 @@ setMethod( #' @rdname spatShift #' @export -setMethod("spatShift", signature("SpatExtent"), - function(x, dx = 0, dy = 0) { - terra::shift(x, dx = dx, dy = dy) - }) +setMethod( + "spatShift", signature("SpatExtent"), + function(x, dx = 0, dy = 0) { + terra::shift(x, dx = dx, dy = dy) + } +) #' @rdname spatShift @@ -140,7 +140,7 @@ setMethod( function(x, dx = 0, dy = 0, dz = 0, copy_obj = TRUE, ...) { argslist <- get_args_list() argslist$x <- x[] - argslist$geom = c("sdimx", "sdimy", "sdimz") + argslist$geom <- c("sdimx", "sdimy", "sdimz") # pass to data.frame method x[] <- do.call(spatShift, argslist) @@ -155,9 +155,8 @@ setMethod( #' @export setMethod( "spatShift", signature("data.frame"), - function( - x, dx = 0, dy = 0, dz = 0, copy_obj = TRUE, - geom = c("sdimx", "sdimy", "sdimz"), ...) { + function(x, dx = 0, dy = 0, dz = 0, copy_obj = TRUE, + geom = c("sdimx", "sdimy", "sdimz"), ...) { x <- data.table::as.data.table(x) x <- .shift_spatial_locations( spatlocs = x, @@ -175,10 +174,8 @@ setMethod( #' @export setMethod( "spatShift", signature("spatialNetworkObj"), - function( - x, dx = 0, dy = 0, dz = 0, - copy_obj = TRUE, ... - ) { + function(x, dx = 0, dy = 0, dz = 0, + copy_obj = TRUE, ...) { x@networkDT <- .shift_spatial_network( spatnet = x@networkDT, dx = dx, dy = dy, dz = dz, ... @@ -235,11 +232,13 @@ setMethod( #' @rdname spatShift #' @export -setMethod("spatShift", signature("giottoAffineImage"), - function(x, dx = 0, dy = 0, ...) { - x@affine <- spatShift(x@affine, dx = dx, dy = dy, ...) - return(initialize(x)) - }) +setMethod( + "spatShift", signature("giottoAffineImage"), + function(x, dx = 0, dy = 0, ...) { + x@affine <- spatShift(x@affine, dx = dx, dy = dy, ...) + return(initialize(x)) + } +) #' @rdname spatShift #' @export @@ -269,12 +268,13 @@ setMethod( #' @param copy_obj logical. copy/duplicate object (default = TRUE) #' @returns spatial locations #' @keywords internal -.shift_spatial_locations <- function(spatlocs, - dx = 0, - dy = 0, - dz = 0, - geom = c("sdimx", "sdimy", "sdimz"), - copy_obj = TRUE) { +.shift_spatial_locations <- function( + spatlocs, + dx = 0, + dy = 0, + dz = 0, + geom = c("sdimx", "sdimy", "sdimz"), + copy_obj = TRUE) { # catch NULL inputs dx <- dx %null% 0 dy <- dy %null% 0 @@ -290,7 +290,9 @@ setMethod( spatlocs[, (geom_col[["x"]]) := get(geom_col[["x"]]) + dx] spatlocs[, (geom_col[["y"]]) := get(geom_col[["y"]]) + dy] - if (dz == 0) return(spatlocs) # return early if no z shift + if (dz == 0) { + return(spatlocs) + } # return early if no z shift if (geom_col[["z"]] %in% colnames(spatlocs)) { # existing z info @@ -325,9 +327,7 @@ setMethod( #' @param copy_obj copy/duplicate object (default = TRUE) #' @returns spatial network #' @keywords internal -.shift_spatial_network <- function( - spatnet, dx = 0, dy = 0, dz = 0, copy_obj = TRUE -) { +.shift_spatial_network <- function(spatnet, dx = 0, dy = 0, dz = 0, copy_obj = TRUE) { # NSE vars sdimx_begin <- sdimx_end <- sdimy_begin <- sdimy_end <- sdimz_begin <- sdimz_end <- NULL @@ -346,7 +346,9 @@ setMethod( sdimy_end = sdimy_end + dy )] - if (dz == 0) return(spatnet) # return early if no zshift + if (dz == 0) { + return(spatnet) + } # return early if no zshift if ("sdimz_begin" %in% colnames(spatnet)) { spatnet[, sdimz_begin := sdimz_begin + dz] @@ -363,8 +365,10 @@ setMethod( # fix col ordering data.table::setcolorder( spatnet, - c("from", "to", "sdimx_begin", "sdimy_begin", "sdimz_begin", - "sdimx_end", "sdimy_end", "sdimz_end") + c( + "from", "to", "sdimx_begin", "sdimy_begin", "sdimz_begin", + "sdimx_end", "sdimy_end", "sdimz_end" + ) ) return(spatnet) @@ -378,16 +382,16 @@ setMethod( #' @param ... additional params to pass #' @keywords internal #' @noRd -.shift_large_image <- function( - image, - dx = 0, - dy = 0, - copy_obj = FALSE, - ... -) { +.shift_large_image <- function(image, + dx = 0, + dy = 0, + copy_obj = FALSE, + ...) { if (copy_obj) image@raster_object <- terra::deepcopy(image@raster_object) - if (all(dx == 0, dy == 0)) return(image) + if (all(dx == 0, dy == 0)) { + return(image) + } image@raster_object <- terra::shift( image@raster_object, @@ -401,13 +405,13 @@ setMethod( #' @param ... additional params to pass #' @keywords internal #' @noRd -.shift_image <- function( - image, - dx = 0, - dy = 0, - ... -) { - if (all(dx == 0, dy == 0)) return(image) +.shift_image <- function(image, + dx = 0, + dy = 0, + ...) { + if (all(dx == 0, dy == 0)) { + return(image) + } e <- ext(image) e_shift <- terra::shift(e, dx = dx, dy = dy) ext(image) <- e_shift @@ -417,13 +421,11 @@ setMethod( #' @rdname spatShift #' @keywords internal #' @noRd -.shift_gpoints <- function( - gpoints, - dx = 0, - dy = 0, - copy_obj = FALSE, - ... -) { +.shift_gpoints <- function(gpoints, + dx = 0, + dy = 0, + copy_obj = FALSE, + ...) { if (copy_obj) gpoints@spatVector <- terra::deepcopy(gpoints@spatVector) if (!all(dx == 0, dy == 0)) { @@ -438,13 +440,11 @@ setMethod( #' @rdname spatShift #' @keywords internal #' @noRd -.shift_gpoly <- function( - gpoly, - dx = 0, - dy = 0, - copy_obj = FALSE, - ... -) { +.shift_gpoly <- function(gpoly, + dx = 0, + dy = 0, + copy_obj = FALSE, + ...) { if (copy_obj) gpoly@spatVector <- terra::deepcopy(gpoly@spatVector) if (!all(dx == 0, dy == 0)) { @@ -455,7 +455,7 @@ setMethod( dx = dx, dy = dy, ... - ) + ) ) } gpoly diff --git a/R/methods-spin.R b/R/methods-spin.R index d5eb979f..7ac3305b 100644 --- a/R/methods-spin.R +++ b/R/methods-spin.R @@ -2,7 +2,7 @@ #' @title Spin an object #' @name spin -#' @description Spin (rotate) an object spatially (usually limited to xy +#' @description Spin (rotate) an object spatially (usually limited to xy #' rotations) #' @param x object #' @param angle numeric. Angle of rotation in degrees @@ -26,9 +26,8 @@ NULL #' @export setMethod( "spin", signature(x = "giotto"), - function( - x, angle, x0 = NULL, y0 = NULL, spat_unit = ":all:", - feat_type = ":all:") { + function(x, angle, x0 = NULL, y0 = NULL, spat_unit = ":all:", + feat_type = ":all:") { a <- list(angle = angle, x0 = x0, y0 = y0) checkmate::assert_character(spat_unit) @@ -153,8 +152,9 @@ setMethod( #' @export setMethod( "spin", signature(x = "spatLocsObj"), - function(x, angle = NULL, x0 = NULL, y0 = NULL, z0 = NULL, - xy_angle = NULL, zy_angle = NULL, xz_angle = NULL) { + function( + x, angle = NULL, x0 = NULL, y0 = NULL, z0 = NULL, + xy_angle = NULL, zy_angle = NULL, xz_angle = NULL) { argslist <- get_args_list() argslist$x <- x[] @@ -174,9 +174,10 @@ setMethod( setMethod( "spin", signature(x = "data.frame"), - function(x, angle = NULL, x0 = NULL, y0 = NULL, z0 = NULL, - xy_angle = NULL, zy_angle = NULL, xz_angle = NULL, - geom = c("sdimx", "sdimy", "sdimz")) { + function( + x, angle = NULL, x0 = NULL, y0 = NULL, z0 = NULL, + xy_angle = NULL, zy_angle = NULL, xz_angle = NULL, + geom = c("sdimx", "sdimy", "sdimz")) { x <- data.table::as.data.table(x) if (!is.null(angle)) xy_angle <- angle @@ -211,9 +212,7 @@ setMethod( #' @rdname spin #' @export -setMethod("spin", signature("giottoLargeImage"), function( - x, angle = NULL, x0 = NULL, y0 = NULL, ... -) { +setMethod("spin", signature("giottoLargeImage"), function(x, angle = NULL, x0 = NULL, y0 = NULL, ...) { a <- get_args_list(...) a$x <- as(x, "giottoAffineImage") # convert to giottoAffineImage res <- do.call(spin, args = a) @@ -222,22 +221,18 @@ setMethod("spin", signature("giottoLargeImage"), function( #' @rdname spin #' @export -setMethod("spin", signature("giottoAffineImage"), function( - x, angle = NULL, x0 = NULL, y0 = NULL, ... -) { +setMethod("spin", signature("giottoAffineImage"), function(x, angle = NULL, x0 = NULL, y0 = NULL, ...) { a <- get_args_list(...) a$x <- x@affine # update affine x@affine <- do.call(spin, args = a) - + return(initialize(x)) }) #' @rdname spin #' @export -setMethod("spin", signature("affine2d"), function( - x, angle = NULL, x0 = NULL, y0 = NULL -) { +setMethod("spin", signature("affine2d"), function(x, angle = NULL, x0 = NULL, y0 = NULL) { a <- get_args_list() # remove from args list if not provided if (is.null(x0)) a$x0 <- NULL @@ -247,7 +242,7 @@ setMethod("spin", signature("affine2d"), function( rotate_m <- matrix(c(cos(r), sin(r), -sin(r), cos(r)), nrow = 2L) old_aff <- new_aff <- x@affine .aff_linear_2d(new_aff) <- .aff_linear_2d(new_aff) %*% rotate_m - + ## calc shifts ## # create dummy d <- .bound_poly(x@anchor) @@ -255,19 +250,19 @@ setMethod("spin", signature("affine2d"), function( a$x <- affine(d, old_aff) # perform new transform post <- do.call(spin, args = a) - + # perform affine & transform without shifts b <- a b$x0 <- b$y0 <- 0 b$x <- affine(d, .aff_linear_2d(old_aff)) pre <- do.call(spin, args = b) - + # find xyshift by comparing tfs so far vs new tf xyshift <- .get_centroid_xy(post) - .get_centroid_xy(pre) - + # update translate .aff_shift_2d(new_aff) <- xyshift - + x@affine <- new_aff return(initialize(x)) }) @@ -281,9 +276,8 @@ setMethod("spin", signature("affine2d"), function( # values are provided through the xy param. # Either rotate_rad or rotate_deg may be provided. Internally, the function # converts everything to radians. -.rotate_2d <- function( - DT, xy = c("x", "y"), rotate_rad = NULL, - rotate_deg = NULL) { +.rotate_2d <- function(DT, xy = c("x", "y"), rotate_rad = NULL, + rotate_deg = NULL) { # send error if both angle inputs exist or both are missing if (is.null(rotate_rad) && is.null(rotate_deg) || !is.null(rotate_rad) && !is.null(rotate_deg)) { @@ -319,10 +313,11 @@ setMethod("spin", signature("affine2d"), function( #' @details Radians are provided through \code{rotateradians} param as a named #' vector with values for \code{xy} (yaw), \code{zy} (pitch), \code{xz} (roll) #' @keywords internal -.rotate_spatial_locations <- function(spatlocs, - rotateradians = c(xy = 0, zy = 0, xz = 0), - rcenter = c(0, 0, 0), - geom = c("sdimx", "sdimy", "sdimz")) { +.rotate_spatial_locations <- function( + spatlocs, + rotateradians = c(xy = 0, zy = 0, xz = 0), + rcenter = c(0, 0, 0), + geom = c("sdimx", "sdimy", "sdimz")) { checkmate::assert_data_table(spatlocs) xyz <- c("x", "y", "z") diff --git a/R/methods-transpose.R b/R/methods-transpose.R index b654258f..189cb0e2 100644 --- a/R/methods-transpose.R +++ b/R/methods-transpose.R @@ -79,7 +79,7 @@ setMethod( x <- setFeatureInfo(x, pt, verbose = FALSE, initialize = FALSE) } } - + # images ----------------------------------------------------------- # imgs <- get_giotto_image_list(x) if (!is.null(imgs)) { @@ -154,7 +154,7 @@ setMethod("t", signature("giottoAffineImage"), function(x) { aff <- x@affine # update affine x@affine <- t(aff) - + return(initialize(x)) }) diff --git a/R/package_imports.R b/R/package_imports.R index fae1d313..922ab0cd 100644 --- a/R/package_imports.R +++ b/R/package_imports.R @@ -1,47 +1,32 @@ -#' @import data.table -#' @import dbscan -#' @import deldir -#' @import magick -#' @import reticulate -#' @import sp -#' @importFrom checkmate assert_character -#' @importFrom igraph graph_from_data_frame -#' @importFrom matrixStats colSds +# All @import tags for GiottoClass should be declared in this dummy documentation # + #' @importFrom methods new #' @importFrom methods as #' @importFrom methods rbind2 #' @importFrom methods setMethod #' @importFrom methods show #' @importFrom methods initialize -#' @importFrom methods slot -#' @importFrom methods slot<- +#' @importFrom methods slot slot<- #' @importFrom methods slotNames #' @importFrom methods validObject -#' @importFrom graphics segments #' @importFrom graphics legend par rect -#' @importFrom grDevices dev.size -#' @importFrom stats cor -#' @importMethodsFrom terra spin -#' @importMethodsFrom terra flip -#' @importMethodsFrom terra rescale +#' @importMethodsFrom terra spin flip rescale t #' @importMethodsFrom Matrix t -#' @importMethodsFrom terra t -#' @importMethodsFrom terra ext -#' @importMethodsFrom terra ext<- +#' @importMethodsFrom terra ext ext<- convHull minCircle minRect #' @importMethodsFrom terra plot #' @importMethodsFrom terra wrap -#' @importMethodsFrom terra vect +#' @importMethodsFrom terra zoom #' @importMethodsFrom terra crop -#' @importMethodsFrom terra as.data.frame -#' @importMethodsFrom terra as.polygons as.points +#' @importMethodsFrom terra vect buffer +#' @importMethodsFrom terra relate +#' @importMethodsFrom terra union erase intersect symdif snap +#' @importMethodsFrom terra as.data.frame as.polygons as.points #' @importMethodsFrom terra nrow ncol -#' @importMethodsFrom terra zoom #' @importMethodsFrom terra hist density -#' @importClassesFrom terra SpatExtent -#' @importClassesFrom terra SpatVector +#' @importClassesFrom terra SpatExtent SpatVector +#' @importMethodsFrom terra area #' @import GiottoUtils #' @import data.table #' @import utils #' @importFrom utils .DollarNames - NULL diff --git a/R/python_bento.R b/R/python_bento.R index 26056488..6983caef 100644 --- a/R/python_bento.R +++ b/R/python_bento.R @@ -8,8 +8,9 @@ #' DEFAULT: "giotto_env" #' @returns bento_adata bento adata object #' @export -createBentoAdata <- function(gobject = NULL, - env_to_use = "giotto_env") { +createBentoAdata <- function( + gobject = NULL, + env_to_use = "giotto_env") { if (!c("giotto") %in% class(gobject)) { stop(wrap_txt("Please provide a valid Giotto Object.", errWidth = TRUE)) } diff --git a/R/python_environment.R b/R/python_environment.R index 20cf2648..35b3124e 100644 --- a/R/python_environment.R +++ b/R/python_environment.R @@ -1,54 +1,52 @@ - - #' @title Giotto python environment #' @name giotto_python #' @description -#' \pkg{Giotto} has several functions that utilize python packages. To +#' Giotto has several functions that utilize python packages. To #' facilitate this, utilities are provided for creating, removing, and #' attaching python environments. Python environments are currently handled #' entirely through \pkg{reticulate}. -#' +#' #' **Creating an environment** -#' +#' #' `installGiottoEnvironment()` can be used to create a default miniconda -#' environment called `giotto_env` that includes some commonly used python -#' packages. See the **python versions** section for specific packages and +#' environment called `giotto_env` that includes some commonly used python +#' packages. See the **python versions** section for specific packages and #' version numbers. -#' +#' #' Custom environments manageable through \pkg{reticulate} are also compatible #' and can be hooked into by Giotto after creation. -#' +#' #' `checkGiottoEnvironment()` can be used in order to test if an envname or #' full python path is accessible by Giotto. It will also check the #' `"giotto.py_path"` option. -#' +#' #' **Choosing environments** -#' +#' #' Only one python environment may be initialized and used by \pkg{reticulate} #' during a single R session. In order to switch to another environment, the #' R session must be restarted. -#' +#' #' Whenever any of the following happens for the first time in a session: -#' -#' - `giotto` object creation (due to creation of a default +#' +#' - `giotto` object creation (due to creation of a default #' `giottoInstructions`) #' - `giottoInstructions` creation (`createGiottoInstructions()`) #' - `GiottoClass::set_giotto_python_path()` is called (most direct) -#' -#' For the above, Giotto automatically detects AND activates a python +#' +#' For the above, Giotto automatically detects AND activates a python #' environment based on the following defaults in decreasing priority: -#' +#' #' 1. User provided (when `python_path` param is not `NULL`) #' 2. Any provided path or envname in option `"giotto.py_path"` -#' 3. Default expected giotto environment location based on +#' 3. Default expected giotto environment location based on #' [reticulate::miniconda_path()] #' 4. Envname `"giotto_env"` #' 5. System default python environment -#' +#' #' This behavior is mediated by the `set_giotto_python_path()` utility #' function, which will find an environment and then initialize it. -#' -#' +#' +#' #' # python versions #' By default, Python v3.10.2 will be used with the following python modules #' for giotto environment installation: @@ -78,26 +76,26 @@ #' - python.app==2 # macOS only #' - scikit-learn==0.24.2 #' } -#' +#' #' # .yml installs #' Please note that multiple .yml files are provided in the #' repository for advanced installation and convenience. To install the most -#' up-to-date Giotto environment using a .yml file, open a shell compatible -#' with conda/miniconda and navigate to the directory specified by -#' `system.file(package = "Giotto", "python/configuration")`. Once in this +#' up-to-date Giotto environment using a .yml file, open a shell compatible +#' with conda/miniconda and navigate to the directory specified by +#' system.file(package = "Giotto", "python/configuration"). Once in this #' directory, run the following to create your environment in one step: -#' +#' #' \preformatted{conda env create -n giotto_env -f ./genv.yml} -#' +#' #' @param envname character. (optional) The name of a miniconda or conda -#' environment OR path to a python executable. When using +#' environment OR path to a python executable. When using #' `installGiottoEnvironment()`, the default is `"giotto_env"` #' @param conda either "auto" (default) to allow reticulate to handle it, or #' the full filepath to the conda executable. You can also set the option #' `"reticulate.conda_binary"` or `Sys.setenv()` `"RETICULATE_CONDA"` to tell #' reticulate where to look. #' @param verbose be verbose -#' +#' NULL @@ -109,13 +107,13 @@ NULL # check #### #' @describeIn giotto_python -#' +#' #' - Based on `envname`, detect if there a conda or miniconda environment -#' accessible by \pkg{Giotto}. By default, the `envname` `"giotto_env"`, then -#' the option `"giotto.py_path"` is checked, but an alternative can be -#' provided. -#' - Setting `envname` as `":auto:"` will let \pkg{Giotto} autodetect a python -#' env to use. See section for `set_giotto_python_path()` for details on the +#' accessible by Giotto. By default, the `envname` `"giotto_env"`, then +#' the option `"giotto.py_path"` is checked, but an alternative can be +#' provided. +#' - Setting `envname` as `":auto:"` will let Giotto autodetect a python +#' env to use. See section for `set_giotto_python_path()` for details on the #' autodetection. #' - Returns `TRUE` if an env is detected and accessible by Giotto. `FALSE` #' if not. Will not initialize a python environment during detection. @@ -123,24 +121,21 @@ NULL #' # detect without initialization #' # check default env location #' checkGiottoEnvironment() -#' +#' #' # use environment name #' checkGiottoEnvironment("giotto_env") -#' -#' # full path +#' +#' # full path #' # (use this if a different install location specified with .condarc) #' if (FALSE) { -#' checkGiottoEnvironment( -#' "/Users/example/Library/r-miniconda-arm64/envs/giotto_env/bin/pythonw" -#' ) +#' checkGiottoEnvironment( +#' "/Users/example/Library/r-miniconda-arm64/envs/giotto_env/bin/pythonw" +#' ) #' } #' @export -checkGiottoEnvironment <- function( - envname = NULL, - mini_install_path = deprecated(), - verbose = NULL -) { - +checkGiottoEnvironment <- function(envname = NULL, + mini_install_path = deprecated(), + verbose = NULL) { if (is_present(mini_install_path)) { deprecate_warn( when = "0.3.2", @@ -149,19 +144,19 @@ checkGiottoEnvironment <- function( ) envname <- mini_install_path } - + if (identical(envname, ":auto:")) { envname <- NULL } else { envname <- envname %null% getOption("giotto.py_path") envname <- envname %null% "giotto_env" } - + if (!file.exists(envname) && isFALSE(.check_conda(error = FALSE))) { # - a conda binary must be detected to use an envname # - if an envname is not provided, the full path to the python binary # is needed - vmsg(.v = verbose, "Unable to find a conda binary. + vmsg(.v = verbose, "Unable to find a conda binary. Use `installGiottoEnvironment()` or install a custom conda.") return(FALSE) # this is also checked in set_giotto_python_path() within @@ -171,50 +166,51 @@ checkGiottoEnvironment <- function( py_path <- set_giotto_python_path( python_path = envname, verbose = FALSE, initialize = FALSE ) - # set_giotto_python_path() returns the path if found. + # set_giotto_python_path() returns the path if found. found <- is.character(py_path) - + if (found) { vmsg(.v = verbose, sprintf( "Giotto can access environment found at: \n'%s'", py_path )) } else { vmsg(.v = verbose, sprintf( - "Giotto cannot find python environment with `envname`: '%s'", + "Giotto cannot find python environment with `envname`: '%s'", envname )) } - - vmsg(.v = verbose, .initial = " ", - "If this is the wrong environment, try specifying `envname` param + + vmsg( + .v = verbose, .initial = " ", + "If this is the wrong environment, try specifying `envname` param or set option \"giotto.py_path\" with the desired envname or path" ) - + return(found) - - # # check for envnames, if found, get the path - # if (!.is_path(envname)) { - # # if a condaenv matches envname, return fullpath - # # otherwise return envname without modification - # envname <- .envname_to_pypath(envname, must_exist = FALSE) - # } - # - # # complete any directory inputs - # # if path does not exist, return NULL - # py_path <- .full_miniconda_path(path = envname) - # - # if (is.null(py_path)) { - # vmsg( - # .v = verbose, - # " Unable to find conda directory", envname, - # "\nPlease ensure the directory exists and is provided as", - # "character." - # ) - # return(FALSE) - # } - # - # vmsg(.v = verbose, "giotto environment found at\n", py_path) - # return(TRUE) + + # # check for envnames, if found, get the path + # if (!.is_path(envname)) { + # # if a condaenv matches envname, return fullpath + # # otherwise return envname without modification + # envname <- .envname_to_pypath(envname, must_exist = FALSE) + # } + # + # # complete any directory inputs + # # if path does not exist, return NULL + # py_path <- .full_miniconda_path(path = envname) + # + # if (is.null(py_path)) { + # vmsg( + # .v = verbose, + # " Unable to find conda directory", envname, + # "\nPlease ensure the directory exists and is provided as", + # "character." + # ) + # return(FALSE) + # } + # + # vmsg(.v = verbose, "giotto environment found at\n", py_path) + # return(TRUE) } @@ -275,6 +271,8 @@ checkGiottoEnvironment <- function( #' @title .install_giotto_environment_specific #' @description installation of giotto environment #' @param packages_to_install python packages to install with giotto env +#' @param pip_packages python packages mush installed with pip, only names +#' are needed #' @param python_version python version to install #' @param mini_install_path directory to install the environment to. #' @param create_dir whether to create the directory specified by @@ -285,26 +283,27 @@ checkGiottoEnvironment <- function( #' @keywords internal #' @noRd #' @returns character or NULL -.install_giotto_environment_specific <- function(packages_to_install = c( - "pandas", "networkx", "python-igraph", - "leidenalg", "python-louvain", "python.app", - "scikit-learn" - ), - python_version = "3.10.2", - mini_install_path = NULL, - confirm = TRUE, - envname = "giotto_env", - conda = "auto", - verbose = NULL) { - +.install_giotto_environment_specific <- function( + packages_to_install = c( + "pandas", "networkx", "python-igraph", + "leidenalg", "python-louvain", "python.app", + "scikit-learn", "smfishhmrf", "session-info" + ), + pip_packages = c("python-louvain", "smfishhmrf", "session-info"), + python_version = "3.10.2", + mini_install_path = NULL, + confirm = TRUE, + envname = "giotto_env", + conda = "auto", + verbose = NULL) { vmsg(.v = verbose, "\n |---- install giotto environment ----| \n") - + ## paths ## ## ----- ## # conda (let reticulate handle it when possible) conda <- conda %null% "auto" conda_path <- reticulate::conda_binary(conda) - + # environment if (is.null(mini_install_path)) { # giotto environment path defaults @@ -327,7 +326,7 @@ checkGiottoEnvironment <- function( } # complete path mini_install_path <- file.path(mini_install_path, "envs", envname) - + # confirm location vmsg(.v = verbose, sprintf( "Installing env to directory:\n\"%s\"", mini_install_path @@ -340,7 +339,7 @@ checkGiottoEnvironment <- function( } if (!input %in% c("y", "Y")) stop("aborting") } - + # create directory if not existing if (!dir.exists(mini_install_path)) { dir.create(mini_install_path, recursive = TRUE) @@ -348,7 +347,7 @@ checkGiottoEnvironment <- function( # user defined path will be used } - + ## identify operating system and adjust the necessary packages ## ## ----------------------------------------------------------- ## os_specific_system <- get_os() @@ -359,39 +358,36 @@ checkGiottoEnvironment <- function( )] } - # python-louvain must be installed with pip, not with conda-forge + # some python packages must be installed with pip, not with conda-forge # `pip_packages` will be installed with pip # `forge_packages` will be installed with conda-forge - forge_packages <- packages_to_install - py_lou <-"python-louvain" - pip_packages <- c("smfishhmrf", "session-info") - if (py_lou %in% packages_to_install) { - pip_packages <- c(pip_packages, py_lou) - forge_packages <- forge_packages[ - forge_packages != py_lou - ] - } - + pip_pkg_indices <- grep(paste0( + "^(", paste(pip_packages, collapse = "|"), + ")" + ), packages_to_install, ignore.case = TRUE) + forge_packages <- packages_to_install[-pip_pkg_indices] + pip_packages <- packages_to_install[pip_pkg_indices] + ## create conda env ## ## ---------------- ## - + a <- list( python_version = python_version, envname = mini_install_path, conda = conda_path ) - + do.call(reticulate::conda_create, args = a) - + ## install python packges ## ## ---------------------- ## - + if (length(forge_packages) > 0L) { do.call( - reticulate::py_install, + reticulate::py_install, args = c(a, list( - packages = forge_packages, - method = "conda", + packages = forge_packages, + method = "conda", channel = c("conda-forge", "vtraag") )) ) @@ -414,21 +410,19 @@ checkGiottoEnvironment <- function( #' @description installation options of giotto environment #' @returns character or NULL #' @keywords internal -.install_giotto_environment <- function( - force_environment = FALSE, - packages_to_install = c( - "pandas", "networkx", "python-igraph", - "leidenalg", "python-louvain", "python.app", - "scikit-learn" - ), - python_version = "3.10.2", - mini_install_path = NULL, - confirm = TRUE, - envname = "giotto_env", - conda = "auto", - verbose = NULL -) { - +.install_giotto_environment <- function(force_environment = FALSE, + packages_to_install = c( + "pandas", "networkx", "python-igraph", + "leidenalg", "python-louvain", "python.app", + "scikit-learn", "smfishhmrf", "session-info" + ), + pip_packages = c("python-louvain", "smfishhmrf", "session-info"), + python_version = "3.10.2", + mini_install_path = NULL, + confirm = TRUE, + envname = "giotto_env", + conda = "auto", + verbose = NULL) { # first see if Giotto environment is already installed giotto_installed <- checkGiottoEnvironment( envname = envname, @@ -437,31 +431,32 @@ checkGiottoEnvironment <- function( # already installed and no force: do nothing & return if (isTRUE(giotto_installed) && !isTRUE(force_environment)) { - vmsg(.v = verbose, + vmsg( + .v = verbose, "An environment usable by Giotto is already installed Run `checkGiottoEnvironment()` to see which is being detected. set force_environment = TRUE to reinstall" ) return(invisible()) # return early } - + # find conda binary (let reticulate handle it when possible) conda <- conda %null% "auto" conda_path <- reticulate::conda_binary(conda) - + # already installed and force: remove original env if (isTRUE(giotto_installed) && isTRUE(force_environment)) { - # first remove giotto environment, then install reticulate::conda_remove( envname = envname, conda = conda_path ) } - + # install giotto environment .install_giotto_environment_specific( packages_to_install = packages_to_install, + pip_packages = pip_packages, python_version = python_version, mini_install_path = mini_install_path, confirm = confirm, @@ -475,16 +470,18 @@ checkGiottoEnvironment <- function( #' @describeIn giotto_python -#' +#' #' - Install a giotto python environment using miniconda through #' \pkg{reticulate}. By default, the envname used will be `"giotto_env"`. If #' another name is used, you will have to provide that envname at the start of -#' a session (see **Choosing an environment** above). \cr This includes a -#' miniconda installation and also a set of python packages that \pkg{Giotto} +#' a session (see **Choosing an environment** above). \cr This includes a +#' miniconda installation and also a set of python packages that Giotto #' may often use. See details for further information on setting up an #' environment with a .yml #' - Returns `NULL` #' @param packages_to_install python modules (packages) to install for Giotto. +#' @param pip_packages python packages mush installed with pip, only names +#' are needed #' @param python_version python version to use within the giotto conda #' environment. Default is v3.10.2 #' @param mini_install_path (optional) desired miniconda installation location. @@ -493,50 +490,53 @@ checkGiottoEnvironment <- function( #' install location (default = TRUE) #' @param force_miniconda force reinstallation of miniconda #' @param force_environment force reinstallation of the giotto environment -#' +#' #' @examples #' if (FALSE) { -#' # default environment installation -#' installGiottoEnvironment() -#' -#' # install to alternate location -#' temp_env <- tempdir() -#' installGiottoEnvironment(mini_install_path = temp_env) +#' # default environment installation +#' installGiottoEnvironment() +#' +#' # install to alternate location +#' temp_env <- tempdir() +#' installGiottoEnvironment(mini_install_path = temp_env) #' } -#' +#' @returns installed Giotto environment #' @export installGiottoEnvironment <- function( - packages_to_install = c( - "pandas==1.5.1", - "networkx==2.8.8", - "python-igraph==0.10.2", - "leidenalg==0.9.0", - "python-louvain==0.16", - "python.app==1.4", - "scikit-learn==1.1.3" - ), - python_version = "3.10.2", - mini_install_path = NULL, - confirm = TRUE, - envname = "giotto_env", - conda = "auto", - force_miniconda = FALSE, - force_environment = FALSE, - verbose = NULL -) { - + packages_to_install = c( + "pandas==1.5.1", + "networkx==2.8.8", + "python-igraph==0.10.2", + "leidenalg==0.9.0", + "python-louvain==0.16", + "python.app==1.4", + "scikit-learn==1.1.3", + "smfishhmrf", + "session-info" + ), + pip_packages = c("python-louvain", "smfishhmrf", "session-info"), + python_version = "3.10.2", + mini_install_path = NULL, + confirm = TRUE, + envname = "giotto_env", + conda = "auto", + force_miniconda = FALSE, + force_environment = FALSE, + verbose = NULL) { ## 1. check and install miniconda locally if necessary conda_found <- .check_conda(conda = conda, error = FALSE) # install miniconda if needed if (isFALSE(conda_found) || isTRUE(force_miniconda)) { - vmsg(.v = verbose, .initial = " ", - "|---- install local miniconda ----|") - + vmsg( + .v = verbose, .initial = " ", + "|---- install local miniconda ----|" + ) + if (identical(conda, "auto")) { conda_path <- reticulate::miniconda_path() } - + reticulate::install_miniconda( path = conda_path, force = force_miniconda @@ -547,12 +547,13 @@ installGiottoEnvironment <- function( if (is.null(mini_install_path)) { confirm <- FALSE # following defaults, no confirm needed } - + .install_giotto_environment( force_environment = force_environment, packages_to_install = packages_to_install, + pip_packages = pip_packages, python_version = python_version, - mini_install_path = mini_install_path, + mini_install_path = mini_install_path, confirm = confirm, envname = envname, conda = conda, @@ -566,18 +567,15 @@ installGiottoEnvironment <- function( #' @describeIn giotto_python -#' +#' #' - Remove a python environment #' - Returns `NULL` #' @param mini_path deprecated #' @export -removeGiottoEnvironment <- function( - envname = "giotto_env", - mini_path = deprecated(), - conda = "auto", - verbose = TRUE -) { - +removeGiottoEnvironment <- function(envname = "giotto_env", + mini_path = deprecated(), + conda = "auto", + verbose = TRUE) { if (is_present(mini_path)) { deprecate_warn( when = "0.3.2", @@ -596,8 +594,8 @@ removeGiottoEnvironment <- function( "Giotto environment is not found and probably never installed" ) } - - # if envname was provided, get pypath from conda_list, + + # if envname was provided, get pypath from conda_list, # then convert to envpath if (!.is_path(envname)) { # if a condaenv matches envname, return fullpath @@ -618,43 +616,43 @@ removeGiottoEnvironment <- function( # detect and activate #### #' @describeIn giotto_python -#' +#' #' - Detect and activate a python path. The `python_path` param -#' accepts both full filepaths to the python executable and envnames. The +#' accepts both full filepaths to the python executable and envnames. The #' final path to use is determined as follows in decreasing priority: -#' +#' #' 1. User provided (when `python_path` is not `NULL`) #' 2. Any provided path or envname in option `"giotto.py_path"` -#' 3. Default expected giotto environment location based on +#' 3. Default expected giotto environment location based on #' [reticulate::miniconda_path()] #' 4. Envname "giotto_env" #' 5. System default python environment -#' -#' - This function exits without doing anything if option `"giotto.use_conda"` +#' +#' - This function exits without doing anything if option `"giotto.use_conda"` #' is `FALSE`. -#' - By default this function will force initialization of the python -#' environment to set, locking the session to that environment. -#' This can be skipped if `initialize = FALSE`, however in that case, the -#' actual python path set downstream may differ from what is expected and +#' - By default this function will force initialization of the python +#' environment to set, locking the session to that environment. +#' This can be skipped if `initialize = FALSE`, however in that case, the +#' actual python path set downstream may differ from what is expected and #' reported by this function. #' - Returns detected path to python binary or `NULL` if none found. -#' @param python_path character. Name of environment or full path to python +#' @param python_path character. Name of environment or full path to python #' executable. #' @param initialize force initialization of set python path. Default = TRUE. #' @keywords internal #' @examples #' # detect AND initialize a python environment -#' set_giotto_python_path() +#' if (FALSE) { +#' set_giotto_python_path() +#' } #' @export -set_giotto_python_path <- function( - python_path = NULL, - verbose = NULL, - initialize = TRUE -) { +set_giotto_python_path <- function(python_path = NULL, + verbose = NULL, + initialize = TRUE) { if (isFALSE(getOption("giotto.use_conda", TRUE))) { return(invisible(NULL)) # exit early } - + # if py_active_env() is character then an environment has already been # initialized. Return early with a verbose message py <- py_active_env() @@ -663,7 +661,7 @@ set_giotto_python_path <- function( "%s\n%s '%s'\n%s %s", "python already initialized in this session", "active environment :", py, - "python version :", getOption("giotto.py_active_ver") + "python version :", getOption("giotto.py_active_ver") )) } @@ -673,11 +671,11 @@ set_giotto_python_path <- function( found_msg <- c( "a python path has been provided", "found python path from option 'giotto.py_path'", - "a giotto python environment was found", + "a giotto python environment was found", "", # skip 4 since it's always printed "a system default python environment was found" ) - + # `specified` flag # flag for when path is directly intended. When not NULL, instead of # quietly passing to next default, send message and immediately return @@ -695,24 +693,24 @@ set_giotto_python_path <- function( if (!is.null(python_path) && length(found) == 0L) { found <- c(found, 2) specified <- sprintf( - "%s: \"%s\"", - "option 'giotto.py_path'", + "%s: \"%s\"", + "option 'giotto.py_path'", getOption("giotto.py_path") - ) + ) } # (3.) check default install path; if not existing, returns NULL # will return NULL for .condarc alternate location "giotto_env" installs python_path <- python_path %null% .os_py_path(must_exist = TRUE) if (!is.null(python_path)) found <- c(found, 3) - + # (4.) check default envname, relying on reticulate::conda_list() # catches .condarc alternate location "giotto_env" if (is.null(python_path)) { python_path <- "giotto_env" vmsg(.v = verbose, "checking default envname \'giotto_env\'") } - + # if an envname was provided, convert to a full python path to test # if no existing python path found, return the envname without changes if (!.is_path(python_path)) { @@ -724,15 +722,17 @@ set_giotto_python_path <- function( # early return NULL if specified and NOT found. if (is.null(python_path) && !is.null(specified)) { - vmsg(.v = verbose, - sprintf("specified py env from %s not found\n", specified)) + vmsg( + .v = verbose, + sprintf("specified py env from %s not found\n", specified) + ) return(invisible()) } - + # (5.) detect from system call; return NULL if not found python_path <- python_path %null% .sys_detect_py() if (!is.null(python_path)) found <- c(found, 5) - + # print any found messages # # ------------------------ # if (length(found) > 0) { @@ -742,11 +742,13 @@ set_giotto_python_path <- function( # if any working python path found; activate the environment and return # # --------------------------------------------------------------------- # - if (!is.null(python_path)) { + if (!is.null(python_path)) { if (isTRUE(initialize)) { - vmsg(.v = verbose, - sprintf("Using python path:\n\"%s\"", python_path)) - + vmsg( + .v = verbose, + sprintf("Using python path:\n\"%s\"", python_path) + ) + # `use_python()` applies a setting in `reticulate:::.globals` # but, python is still not initialized reticulate::use_python(required = TRUE, python = python_path) @@ -756,7 +758,7 @@ set_giotto_python_path <- function( return(python_path) } - + # otherwise, not found -- helpful prints vmsg("no default python path found. For full functionality, install python and/or use @@ -784,8 +786,9 @@ set_giotto_python_path <- function( #' @description prompts user to install a package #' @keywords internal #' @returns numeric -.py_install_prompt <- function(package = NULL, - env = NULL) { +.py_install_prompt <- function( + package = NULL, + env = NULL) { if (is.null(package) || is.null(env)) { stop(GiottoUtils::wrap_txt("Incorrect Usage.\n", errWidth = TRUE)) } @@ -817,8 +820,9 @@ set_giotto_python_path <- function( #' Installs `link` to python `env` #' @keywords internal #' @returns character or NULL -.install_github_link_pip <- function(link = NULL, - env = NULL) { +.install_github_link_pip <- function( + link = NULL, + env = NULL) { # Guard if (is.null(link) | is.null(env)) { stop(GiottoUtils::wrap_txt("Incorrect Usage.", errWidth = TRUE)) @@ -863,8 +867,9 @@ set_giotto_python_path <- function( #' `reticulate` package. #' @keywords internal #' @returns character or NULL -.install_py_pkg_reticulate <- function(package = NULL, - env = NULL) { +.install_py_pkg_reticulate <- function( + package = NULL, + env = NULL) { resp <- .py_install_prompt( package = package, env = env @@ -915,9 +920,10 @@ set_giotto_python_path <- function( #' URL will be installed. This function should only be provided #' one parameter, or the other. #' @keywords internal -checkPythonPackage <- function(package_name = NULL, - github_package_url = NULL, - env_to_use = "giotto_env") { +checkPythonPackage <- function( + package_name = NULL, + github_package_url = NULL, + env_to_use = "giotto_env") { # Guard clauses if (is.null(package_name) & is.null(github_package_url)) { null_input_err_msg <- "A python package name must be provided, @@ -1067,17 +1073,19 @@ checkPythonPackage <- function(package_name = NULL, # determine if a conda binary is accessible by reticulate # return path to binary if found # return FALSE if `error` != TRUE ignoring, reticulate's thrown error -# +# # param conda - what conda path to use. # param error - whether to stop execution when conda not found .check_conda <- function(conda = "auto", error = TRUE) { res <- try(reticulate::conda_binary(conda = conda), silent = TRUE) if (inherits(res, "try-error")) res <- FALSE - + if (isFALSE(res) && isTRUE(error)) { - stop(wrap_txt( - "Unable to find a conda binary. - Use `installGiottoEnvironment()` or install a custom conda."), + stop( + wrap_txt( + "Unable to find a conda binary. + Use `installGiottoEnvironment()` or install a custom conda." + ), call. = FALSE ) } @@ -1094,12 +1102,10 @@ checkPythonPackage <- function(package_name = NULL, # subdirectory. # NULL is returned if the executable is not found if `must_exist` is TRUE # when `must_exist` is FALSE, the built path is always returned -.os_py_path <- function( - path = reticulate::miniconda_path(), - envname = "giotto_env", - os = get_os(), - must_exist = TRUE -) { +.os_py_path <- function(path = reticulate::miniconda_path(), + envname = "giotto_env", + os = get_os(), + must_exist = TRUE) { if (!checkmate::test_directory_exists(path)) { vmsg(.is_debug = TRUE, ".os_py_path: base dir not found!") } @@ -1128,9 +1134,9 @@ checkPythonPackage <- function(package_name = NULL, .pypath_to_envpath <- function(python_path) { os <- get_os() remove <- switch(os, - "osx" = "bin/pythonw$|bin/python$", - "windows" = "python.exe", - "linux" = "bin/python" + "osx" = "bin/pythonw$|bin/python$", + "windows" = "python.exe", + "linux" = "bin/python" ) gsub(remove, "", python_path) } @@ -1140,14 +1146,17 @@ checkPythonPackage <- function(package_name = NULL, # if not, return without modification .envname_to_pypath <- function(envname, must_exist = TRUE) { .check_conda() - + envs <- reticulate::conda_list() enames <- envs$name epaths <- envs$python - if (envname %in% enames) envname <- epaths[enames == envname] - else if (isTRUE(must_exist)) { - stop(sprintf("envname '%s' not found in reticulate::conda_list()", - envname), call. = FALSE) + if (envname %in% enames) { + envname <- epaths[enames == envname] + } else if (isTRUE(must_exist)) { + stop(sprintf( + "envname '%s' not found in reticulate::conda_list()", + envname + ), call. = FALSE) } return(envname) } @@ -1159,23 +1168,22 @@ checkPythonPackage <- function(package_name = NULL, # `reticulate::miniconda_path()` as the base. # If no file is detected, NULL is returned. .full_miniconda_path <- function(path = NULL) { - # default giotto_env install location if (is.null(path)) { return(.os_py_path()) } - - if (checkmate::test_file_exists(path)) { + + if (checkmate::test_file_exists(path)) { # fullpath res <- path - } else if (dir.exists(path)) { + } else if (dir.exists(path)) { # specific install location (.condarc) + giotto_env default name res <- .os_py_path(path) - } else { + } else { # specific envname under reticulate::miniconda_path() directory res <- .os_py_path(envname = path) } - + return(res) } @@ -1185,8 +1193,8 @@ checkPythonPackage <- function(package_name = NULL, res <- try( { switch(.Platform[["OS.type"]], - "unix" = system("which python3", intern = TRUE), - "windows" = system("where python3", intern = TRUE) + "unix" = system("which python3", intern = TRUE), + "windows" = system("where python3", intern = TRUE) ) }, silent = TRUE diff --git a/R/save_load.R b/R/save_load.R index 992ebd4b..935773e1 100644 --- a/R/save_load.R +++ b/R/save_load.R @@ -9,9 +9,14 @@ #' @param method method to save main object #' @param method_params additional method parameters for RDS or qs #' @param overwrite Overwrite existing folders +#' @param export_image logical. Write out an image of the format specified by +#' `image_filetype` when saving a `giottoLargeImage`. +#' Future image loads and reconnects will point to this new file. #' @param image_filetype the image filetype to use, see #' \code{\link[terra]{writeRaster}}. Default is "PNG". For TIFF outputs, try #' "COG" +#' @param include_feat_coord logical. Whether to keep the feature coordinates +#' when saving. Dropping them can improve performance for large datasets. #' @param verbose be verbose #' @param ... additional parameters for \code{\link[terra]{writeRaster}} #' @returns Creates a directory with Giotto object information @@ -23,16 +28,17 @@ #' #' saveGiotto(gobject = g, dir = tempdir(), overwrite = TRUE) #' @export -saveGiotto <- function( - gobject, - foldername = "saveGiottoDir", - dir = getwd(), - method = c("RDS", "qs"), - method_params = list(), - overwrite = FALSE, - image_filetype = "PNG", - verbose = TRUE, - ...) { +saveGiotto <- function(gobject, + foldername = "saveGiottoDir", + dir = getwd(), + method = c("RDS", "qs"), + method_params = list(), + overwrite = FALSE, + export_image = TRUE, + image_filetype = "PNG", + include_feat_coord = TRUE, + verbose = TRUE, + ...) { # check params checkmate::assert_character(foldername) checkmate::assert_character(dir) @@ -45,6 +51,10 @@ saveGiotto <- function( dir <- normalizePath(dir) final_dir <- file.path(dir, foldername) + if (isFALSE(include_feat_coord)) { + gobject@feat_info <- NULL + } + overwriting <- FALSE if (dir.exists(final_dir)) { if (!overwrite) { @@ -56,7 +66,7 @@ saveGiotto <- function( overwrite folder") overwriting <- TRUE use_dir <- file.path(dir, ".giotto_scratch") - dir.create(use_dir, recursive = TRUE) + dir.create(use_dir, recursive = TRUE, showWarnings = FALSE) } } else { dir.create(final_dir, recursive = TRUE) @@ -93,7 +103,7 @@ saveGiotto <- function( ) terra::writeVector( x = gobject@feat_info[[feat]]@spatVector, - filename = filename + filename = filename, overwrite = TRUE ) } @@ -135,7 +145,7 @@ saveGiotto <- function( ) terra::writeVector( gobject@spatial_info[[spatinfo]]@spatVector, - filename = filename + filename = filename, overwrite = TRUE ) } @@ -163,7 +173,7 @@ saveGiotto <- function( ) terra::writeVector( gobject@spatial_info[[spatinfo]]@spatVectorCentroids, - filename = filename + filename = filename, overwrite = TRUE ) } @@ -198,7 +208,7 @@ saveGiotto <- function( ) terra::writeVector( gobject@spatial_info[[spatinfo]]@overlaps[[feature]], - filename = filename + filename = filename, overwrite = TRUE ) } } @@ -212,27 +222,36 @@ saveGiotto <- function( # only `giottoLargeImages` need to be saved separately image_names <- list_images_names(gobject, img_type = "largeImage") - if (!is.null(image_names)) { + if (!is.null(image_names) && export_image) { image_dir <- paste0(use_dir, "/", "Images") dir.create(image_dir) for (image in image_names) { vmsg(.v = verbose, "For image information: ", image) - r <- gobject@images[[image]]@raster_object + img <- gobject[["images", image]][[1L]] # extract image + r <- img@raster_object if (!is.null(r)) { - # save extent info just in case - gobject@images[[image]]@extent <- terra::ext(r)[] + # save extent info (needed for non-COG outputs) + img@extent <- terra::ext(r)[] + # update filepath + img@file_path <- filename # save raster - filename <- paste0(image_dir, "/", image, "_spatRaster") + filename <- file.path(image_dir, paste0(image, "_spatRaster")) terra::writeRaster( x = r, filename = filename, filetype = image_filetype, NAflag = NA, overwrite = TRUE - ) # test + ) + + # update image in gobject + gobject <- setGiotto( + gobject, img, + verbose = FALSE + ) } } } @@ -298,12 +317,13 @@ saveGiotto <- function( #' #' loadGiotto(path_to_folder = paste0(td, "/saveGiottoDir")) #' @export -loadGiotto <- function(path_to_folder, - load_params = list(), - reconnect_giottoImage = TRUE, - python_path = NULL, - init_gobject = TRUE, - verbose = TRUE) { +loadGiotto <- function( + path_to_folder, + load_params = list(), + reconnect_giottoImage = TRUE, + python_path = NULL, + init_gobject = TRUE, + verbose = TRUE) { # data.table vars img_type <- NULL @@ -320,7 +340,7 @@ loadGiotto <- function(path_to_folder, load_params = load_params, verbose = verbose ) - + ### ### spatial information loading ### ### # terra vector objects are serialized as .shp files. # These .shp files have to be read back in and then the relevant objects @@ -329,7 +349,7 @@ loadGiotto <- function(path_to_folder, ## 2. read in spatial features gobject <- .load_giotto_feature_info( gobject = gobject, - path_to_folder = path_to_folder, + path_to_folder = path_to_folder, verbose = verbose ) @@ -344,21 +364,16 @@ loadGiotto <- function(path_to_folder, ## 4. images # compatibility for pre-v0.3.0 - gobject <- .update_image_slot(gobject) + gobject <- .update_image_slot(gobject) # merge largeImages slot to images gobject <- .load_giotto_images( gobject = gobject, path_to_folder = path_to_folder, verbose = verbose ) - + if (isTRUE(reconnect_giottoImage)) { - if (!is.null(list_images(gobject))) { - if (list_images(gobject)[img_type == "image", .N] > 0) { - gobject <- reconnectGiottoImage(gobject, - reconnect_type = "image" - ) - } - } + imglist <- lapply(gobject[["images"]], reconnect) + gobject <- setGiotto(gobject, imglist, verbose = FALSE) } @@ -367,8 +382,10 @@ loadGiotto <- function(path_to_folder, if (isTRUE(getOption("giotto.use_conda", TRUE))) { identified_python_path <- set_giotto_python_path( python_path = python_path, - verbose = verbose + verbose = verbose, + initialize = TRUE ) + vmsg(.v = verbose, .is_debug = TRUE, identified_python_path) gobject <- changeGiottoInstructions( gobject = gobject, params = c("python_path"), @@ -400,15 +417,13 @@ loadGiotto <- function(path_to_folder, # load in the gobject S4 object. # the contained point-based information will need to be regenerated/reconnected # returns either a gobject or nothing if the file is missing or errors -.load_gobject_core <- function( - path_to_folder, load_params, verbose = NULL -) { +.load_gobject_core <- function(path_to_folder, load_params, verbose = NULL) { vmsg(.v = verbose, "1. read Giotto object") - + # gobject is expected to be saved with a filename like gobject.[ext] # This item is the main S4 structure. gobject_file <- list.files(path_to_folder, pattern = "gobject") - + if (identical(gobject_file, character(0))) { # no matches vmsg(.v = verbose, "giotto object was not found skip loading giotto object") @@ -416,7 +431,6 @@ loadGiotto <- function(path_to_folder, vmsg(.v = verbose, "more than 1 giotto object was found skip loading giotto object") } else { - # pick a reading function read_fun <- NULL if (grepl(".RDS", x = gobject_file)) { # .RDS file @@ -428,68 +442,75 @@ loadGiotto <- function(path_to_folder, read_fun <- get("qread", asNamespace("qs")) full_path <- file.path(path_to_folder, "gobject.qs") } - + if (is.null(read_fun)) { # unrecognized file - stop("object is not a recognized save format.\n ", - ".RDS, .qs are supported\n") + stop( + "object is not a recognized save format.\n ", + ".RDS, .qs are supported\n" + ) } - + # read in the object gobject <- do.call( - read_fun, args = c(file = full_path, load_params) + read_fun, + args = c(file = full_path, load_params) ) return(gobject) } } # load and append spatial feature information -.load_giotto_feature_info <- function( - gobject, path_to_folder, verbose = NULL -) { +.load_giotto_feature_info <- function(gobject, path_to_folder, verbose = NULL) { vmsg(.v = verbose, "2. read Giotto feature information") - vmsg(.v = verbose, .is_debug = TRUE, .initial = " ", - box_chars()$l, "subdir: /Features/", sep = "") - + vmsg( + .v = verbose, .is_debug = TRUE, .initial = " ", + box_chars()$l, "subdir: /Features/", sep = "" + ) + feats_dir <- file.path(path_to_folder, "Features") manifest <- dir_manifest(feats_dir) basenames <- names(manifest) - + # basenames of .shp files to load shp_files <- basenames[grepl(".shp", basenames)] - + # return early if none, also catches when dir does not exist - if (length(shp_files) == 0) return(gobject) - + if (length(shp_files) == 0) { + return(gobject) + } + # parse the feature type(s) to load from the .shp basenames - feats <- gsub(shp_files, + feats <- gsub(shp_files, pattern = "_feature_spatVector.shp", replacement = "" ) - + # basenames of .txt files to load # These have attribute info names (e.g. feat_ID, feat_ID_uniq) # this is done since serialized SpatVectors may have clipped names. txt_files <- paste0(feats, "_feature_spatVector_names.txt") - + # ordering of files follow feats. # Apply name to make indexing simple and unique names(shp_files) <- names(txt_files) <- feats - + # iterate through features discovered and load/regenerate each # then append the information to the gobject for (feat in feats) { load_shp <- manifest[[shp_files[[feat]]]] load_txt <- manifest[[txt_files[[feat]]]] - vmsg(.v = verbose, .is_debug = TRUE, .initial = " ", - sprintf("[%s] %s", feat, basename(load_shp))) + vmsg( + .v = verbose, .is_debug = TRUE, .initial = " ", + sprintf("[%s] %s", feat, basename(load_shp)) + ) spatVector <- terra::vect(x = 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 - + gobject@feat_info[[feat]]@spatVector <- spatVector } @@ -497,37 +518,39 @@ loadGiotto <- function(path_to_folder, } # load and append to gobject the spatial polygon information -.load_giotto_spatial_info <- function( - gobject, path_to_folder, verbose = NULL -) { +.load_giotto_spatial_info <- function(gobject, path_to_folder, verbose = NULL) { vmsg(.v = verbose, "3. read Giotto spatial information") - vmsg(.v = verbose, .is_debug = TRUE, .initial = " ", - box_chars()$l, "subdir: /SpatialInfo/", sep = "") - + vmsg( + .v = verbose, .is_debug = TRUE, .initial = " ", + box_chars()$l, "subdir: /SpatialInfo/", sep = "" + ) + spat_dir <- file.path(path_to_folder, "SpatialInfo") manifest <- dir_manifest(spat_dir) basenames <- names(manifest) - + # basenames of .shp files to load # there are other .shp files for centroids and overlaps in this dir # so the search term is more specific shp_files <- basenames[grepl("spatVector.shp", basenames)] - + # return early if none, also catches when dir does not exist - if (length(shp_files) == 0) return(gobject) - + if (length(shp_files) == 0) { + return(gobject) + } + ## 3.1. shapes vmsg(.v = verbose, "3.1 read Giotto spatial shape information") - + # parse the spatial unit(s) to load from the .shp basenames spats <- gsub(shp_files, - pattern = "_spatInfo_spatVector.shp", replacement = "" + pattern = "_spatInfo_spatVector.shp", replacement = "" ) - + # basenames of .txt files to load # .shp files may clip these normally, so we load them separately txt_files <- paste0(spats, "_spatInfo_spatVector_names.txt") - + # ordering of files follow spats. # Apply name to make indexing simple and unique names(shp_files) <- names(txt_files) <- spats @@ -537,20 +560,22 @@ loadGiotto <- function(path_to_folder, for (spat in spats) { load_shp <- manifest[[shp_files[[spat]]]] load_txt <- manifest[[txt_files[[spat]]]] - - vmsg(.v = verbose, .is_debug = TRUE, .initial = " ", - sprintf("[%s] %s", spat, basename(load_shp))) + + vmsg( + .v = verbose, .is_debug = TRUE, .initial = " ", + sprintf("[%s] %s", spat, basename(load_shp)) + ) spatVector <- terra::vect(x = 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 - + gobject@spatial_info[[spat]]@spatVector <- spatVector } - + # load centroids of gpoly gobject <- .load_giotto_spatial_info_centroids( @@ -560,149 +585,165 @@ loadGiotto <- function(path_to_folder, spats = spats, verbose = verbose ) - + # load overlaps of gpoly gobject <- .load_giotto_spatial_info_overlaps( gobject = gobject, manifest = manifest, verbose = verbose ) - + return(gobject) } # load and append to gobject the polygons centroids information -.load_giotto_spatial_info_centroids <- function( - gobject, manifest, basenames, spats, verbose = NULL -) { +.load_giotto_spatial_info_centroids <- function(gobject, manifest, basenames, spats, verbose = NULL) { ## 3.2. centroids vmsg(.v = verbose, "3.2 read Giotto spatial centroid information \n") - + # these files are optional, depending on if they have been calculated. # They may not exist - + shp_search <- paste0(spats, "_spatInfo_spatVectorCentroids.shp") shp_files <- basenames[basenames %in% shp_search] - + # return early if none exist - if (length(shp_files) == 0) return(gobject) - + if (length(shp_files) == 0) { + return(gobject) + } + txt_files <- paste0(spats, "_spatInfo_spatVectorCentroids_names.txt") - + # 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_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))) + vmsg( + .v = verbose, .is_debug = TRUE, .initial = " ", + sprintf("[%s] %s", spat, basename(load_shp)) + ) 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 - + gobject@spatial_info[[spat]]@spatVectorCentroids <- spatVector } return(gobject) } # load and append to gobject the polygons overlaps information -.load_giotto_spatial_info_overlaps <- function( - gobject, manifest, verbose = NULL -) { +.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) { - + + 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))) + + 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 +# .update_giotto_image() <- this is NEEDED for legacy structure support +# raster reload <- not needed +# filepath update <- now done after this, but useful for legacy saves .load_giotto_images <- function(gobject, path_to_folder, verbose = NULL) { - vmsg(.v = verbose, "4. read Giotto image information") - vmsg(.v = verbose, .is_debug = TRUE, .initial = " ", - box_chars()$l, "subdir: /Images/", sep = "") + vmsg( + .v = verbose, .is_debug = TRUE, .initial = " ", + box_chars()$l, "subdir: /Images/", sep = "" + ) imgs_dir <- file.path(path_to_folder, "Images") manifest <- dir_manifest(imgs_dir) basenames <- names(manifest) - + # basenames of imgs to load img_files <- basenames[grepl("_spatRaster$", basenames)] - + # return early if none, also catches when dir does not exist - if (length(img_files) == 0) return(gobject) - + if (length(img_files) == 0) { + return(gobject) + } + # parse the image name to load imgs <- gsub(img_files, pattern = "_spatRaster", replacement = "") - + names(img_files) <- imgs - + for (img in imgs) { load_img <- manifest[[img_files[[img]]]] - - vmsg(.v = verbose, .is_debug = TRUE, .initial = " ", - sprintf("[%s] %s", img, basename(load_img))) + + vmsg( + .v = verbose, .is_debug = TRUE, .initial = " ", + sprintf("[%s] %s", img, basename(load_img)) + ) spatRaster <- terra::rast(load_img) - + gobject@images[[img]]@raster_object <- spatRaster + # file path updating now happens during export, but keep this in for + # legacy saved object support gobject@images[[img]]@file_path <- load_img + gobject@images[[img]] <- .update_giotto_image(gobject@images[[img]]) + gobject@images[[img]] <- initialize(gobject@images[[img]]) } - + return(gobject) } .gpoly_overlap_names <- function(x, type = c("point", "intensity")) { type <- match.arg(type, choices = c("point", "intensity")) ovlps <- overlaps(x) - if (is.null(ovlps)) return(NULL) - + if (is.null(ovlps)) { + return(NULL) + } + switch(type, "point" = { res <- names(ovlps) @@ -716,4 +757,3 @@ loadGiotto <- function(path_to_folder, ) return(res) } - diff --git a/R/slot_accessors.R b/R/slot_accessors.R index ec793e8c..562e6136 100644 --- a/R/slot_accessors.R +++ b/R/slot_accessors.R @@ -207,11 +207,12 @@ read_s4_nesting <- function(x) { #' are stored within the giotto object's \code{cell_ID} slot. Getters and #' setters for this slot directly retrieve (get) or replace (set) this slot. #' @seealso set_cell_id -#' @family functions to set data in giotto object #' @keywords internal -get_cell_id <- function(gobject, - spat_unit = NULL, - set_defaults = TRUE) { +#' @noRd +get_cell_id <- function( + gobject, + spat_unit = NULL, + set_defaults = TRUE) { assert_giotto(gobject) if (isTRUE(set_defaults)) { spat_unit <- set_default_spat_unit( @@ -251,13 +252,14 @@ get_cell_id <- function(gobject, #' values are AUTOMATICALLY updated every time \code{initialize()} is called #' on the giotto object. #' @seealso get_cell_id -#' @family functions to set data in giotto object #' @keywords internal -set_cell_id <- function(gobject, - spat_unit = NULL, - cell_IDs, - set_defaults = TRUE, - verbose = TRUE) { +#' @noRd +set_cell_id <- function( + gobject, + spat_unit = NULL, + cell_IDs, + set_defaults = TRUE, + verbose = TRUE) { assert_giotto(gobject) # set default spat_unit @@ -333,9 +335,11 @@ set_cell_id <- function(gobject, #' @seealso set_feat_id #' @family functions to set data in giotto object #' @keywords internal -get_feat_id <- function(gobject, - feat_type = NULL, - set_defaults = TRUE) { +#' @noRd +get_feat_id <- function( + gobject, + feat_type = NULL, + set_defaults = TRUE) { assert_giotto(gobject) if (isTRUE(set_defaults)) { spat_unit <- set_default_spat_unit( @@ -382,22 +386,24 @@ get_feat_id <- function(gobject, #' @seealso get_feat_id #' @family functions to set data in giotto object #' @keywords internal -set_feat_id <- function(gobject, - feat_type = NULL, - feat_IDs, - set_defaults = TRUE, - verbose = TRUE) { +#' @noRd +set_feat_id <- function( + gobject, + feat_type = NULL, + feat_IDs, + set_defaults = TRUE, + verbose = TRUE) { assert_giotto(gobject) if (isTRUE(set_defaults)) { if (identical(feat_IDs, "initialize")) { - spat_unit <- suppressWarnings( + spat_unit <- handle_warnings( # expected to be missing sometimes with init set_default_spat_unit( gobject = gobject, spat_unit = NULL ) - ) + )$result } else { spat_unit <- set_default_spat_unit( gobject = gobject, @@ -583,16 +589,14 @@ set_feat_id <- function(gobject, #' @keywords internal #' @description Get cell metadata from giotto object #' @returns a data.table or cellMetaObj -#' @seealso pDataDT -#' @export -get_cell_metadata <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - output = c("cellMetaObj", "data.table"), - copy_obj = TRUE, - set_defaults = TRUE) { - deprecate_soft("3.3.0", "get_cell_metadata()", "getCellMetadata()") - +#' @noRd +get_cell_metadata <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + output = c("cellMetaObj", "data.table"), + copy_obj = TRUE, + set_defaults = TRUE) { output <- match.arg(output, choices = c("cellMetaObj", "data.table")) # 1. Set feat_type and spat_unit @@ -640,17 +644,19 @@ get_cell_metadata <- function(gobject, #' @returns a data.table or cellMetaObj #' @description Get cell metadata from giotto object #' @seealso pDataDT +#' @family functions to get data from giotto object #' @examples #' g <- GiottoData::loadGiottoMini("visium") #' #' getCellMetadata(g) #' @export -getCellMetadata <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - output = c("cellMetaObj", "data.table"), - copy_obj = TRUE, - set_defaults = TRUE) { +getCellMetadata <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + output = c("cellMetaObj", "data.table"), + copy_obj = TRUE, + set_defaults = TRUE) { get_cell_metadata( gobject = gobject, spat_unit = spat_unit, @@ -686,13 +692,15 @@ getCellMetadata <- function(gobject, #' #' setCellMetadata(gobject = g, x = createCellMetaObj(m2)) #' @export -setCellMetadata <- function(gobject, - x, - spat_unit = NULL, - feat_type = NULL, - provenance = NULL, - verbose = TRUE, - initialize = TRUE) { +setCellMetadata <- function( + gobject, + x, + spat_unit = NULL, + feat_type = NULL, + provenance = NULL, + verbose = TRUE, + initialize = TRUE, + ...) { assert_giotto(gobject) if (!methods::hasArg(x)) { stop(wrap_txt("x param (data to set) must be given", @@ -701,9 +709,11 @@ setCellMetadata <- function(gobject, } # check hierarchical slots - used_su <- list_cell_id_names(gobject) - if (is.null(used_su)) { - stop(wrap_txt("Add expression or spatial (polygon) information first")) + if (getOption("giotto.check_valid", TRUE)) { + used_su <- list_cell_id_names(gobject) + if (is.null(used_su)) { + stop(wrap_txt("Add expression or spatial (polygon) information first")) + } } # 1. Determine user inputs @@ -775,19 +785,17 @@ setCellMetadata <- function(gobject, #' the object. #' @param verbose be verbose #' @returns giotto object -#' @family functions to set data in giotto object #' @keywords internal -#' @export -set_cell_metadata <- function(gobject, - metadata, - spat_unit = NULL, - feat_type = NULL, - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE) { - deprecate_soft("3.3.0", "set_cell_metadata()", "setCellMetadata()") - +#' @noRd +set_cell_metadata <- function( + gobject, + metadata, + spat_unit = NULL, + feat_type = NULL, + provenance = NULL, + verbose = TRUE, + set_defaults = TRUE, + initialize = FALSE) { # data.table vars cell_ID <- NULL @@ -1006,15 +1014,14 @@ set_cell_metadata <- function(gobject, #' @returns a data.table or featMetaObj #' @seealso fDataDT #' @keywords internal -#' @export -get_feature_metadata <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - output = c("featMetaObj", "data.table"), - copy_obj = TRUE, - set_defaults = TRUE) { - deprecate_soft("3.3.0", "get_feature_metadata()", "getFeatureMetadata()") - +#' @noRd +get_feature_metadata <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + output = c("featMetaObj", "data.table"), + copy_obj = TRUE, + set_defaults = TRUE) { output <- match.arg(output, choices = c("featMetaObj", "data.table")) # 1. Set feat_type and spat_unit @@ -1057,18 +1064,20 @@ get_feature_metadata <- function(gobject, #' @param copy_obj whether to perform a deepcopy of the data.table information #' @returns a data.table or featMetaObj #' @description Get feature metadata from giotto object +#' @family functions to get data from giotto object #' @seealso fDataDT #' @examples #' g <- GiottoData::loadGiottoMini("vizgen") #' #' getFeatureMetadata(g) #' @export -getFeatureMetadata <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - output = c("featMetaObj", "data.table"), - copy_obj = TRUE, - set_defaults = TRUE) { +getFeatureMetadata <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + output = c("featMetaObj", "data.table"), + copy_obj = TRUE, + set_defaults = TRUE) { get_feature_metadata( gobject = gobject, spat_unit = spat_unit, @@ -1104,13 +1113,15 @@ getFeatureMetadata <- function(gobject, #' #' setFeatureMetadata(gobject = g, x = createFeatMetaObj(m2)) #' @export -setFeatureMetadata <- function(gobject, - x, - spat_unit = NULL, - feat_type = NULL, - provenance = NULL, - verbose = TRUE, - initialize = TRUE) { +setFeatureMetadata <- function( + gobject, + x, + spat_unit = NULL, + feat_type = NULL, + provenance = NULL, + verbose = TRUE, + initialize = TRUE, + ...) { assert_giotto(gobject) if (!methods::hasArg(x)) { stop(wrap_txt("x param (data to set) must be given", @@ -1188,19 +1199,17 @@ setFeatureMetadata <- function(gobject, #' object. #' @param verbose be verbose #' @returns giotto object -#' @family functions to set data in giotto object #' @keywords internal -#' @export -set_feature_metadata <- function(gobject, - metadata, - spat_unit = NULL, - feat_type = NULL, - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE) { - deprecate_soft("3.3.0", "set_feature_metadata()", "setFeatureMetadata()") - +#' @noRd +set_feature_metadata <- function( + gobject, + metadata, + spat_unit = NULL, + feat_type = NULL, + provenance = NULL, + verbose = TRUE, + set_defaults = TRUE, + initialize = FALSE) { # data.table vars feat_ID <- NULL @@ -1413,6 +1422,7 @@ set_feature_metadata <- function(gobject, #' @title Get expression values #' @name getExpression +#' @aliases getExpressionValues #' @description Function to get expression values from giotto object #' @inheritParams data_access_params #' @param values expression values to @@ -1428,16 +1438,13 @@ set_feature_metadata <- function(gobject, #' #' getExpression(g) #' @export -getExpression <- function( - gobject, - values = NULL, - spat_unit = NULL, - feat_type = NULL, - output = c("exprObj", "matrix"), - set_defaults = TRUE) { - - - # 0. Check input +getExpression <- function(gobject, + values = NULL, + spat_unit = NULL, + feat_type = NULL, + output = c("exprObj", "matrix"), + set_defaults = TRUE) { + # 0. Check input assert_giotto(gobject) output <- match.arg(output, choices = c("exprObj", "matrix")) @@ -1494,26 +1501,23 @@ getExpression <- function( #' @param output what object type to retrieve the expression as. Currently #' either matrix' for the matrix object contained in the exprObj or #' 'exprObj' (default) for the exprObj itself are allowed. +#' @keywords internal #' @returns exprObj or matrix depending on output param -#' @export -get_expression_values <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - values = c('raw', 'normalized', 'scaled'), - output = c("exprObj", "matrix"), - set_defaults = TRUE) { - - deprecate_soft("3.3.0", "get_expression_values()", "getExpression()") - +#' @noRd +get_expression_values <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + values = c("raw", "normalized", "scaled"), + output = c("exprObj", "matrix"), + set_defaults = TRUE) { assert_giotto(gobject) ## check parameters values <- match.arg( - arg = values, - choices = unique(c("raw", "normalized", "scaled", values)) + arg = values, + choices = unique(c("raw", "normalized", "scaled", values)) ) - + output <- match.arg(output, choices = c("exprObj", "matrix")) # 1. Set feat_type and spat_unit @@ -1529,7 +1533,7 @@ get_expression_values <- function( ) } - + # 2. Find object potential_values <- list_expression_names( gobject = gobject, @@ -1609,11 +1613,12 @@ get_expression_values <- function( #' @keywords internal #' @return list of exprObj #' @noRd -get_expression_values_list <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - output = c("exprObj", "matrix"), - set_defaults = TRUE) { +get_expression_values_list <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + output = c("exprObj", "matrix"), + set_defaults = TRUE) { assert_giotto(gobject) output <- match.arg(output, choices = c("exprObj", "matrix")) @@ -1648,6 +1653,7 @@ get_expression_values_list <- function(gobject, #' @title Set expression data #' @name setExpression +#' @aliases setExpressionValues #' @description Function to set expression values for giotto object. #' @inheritParams data_access_params #' @param x exprObj or list of exprObj to set. Passing NULL will remove a @@ -1667,14 +1673,16 @@ get_expression_values_list <- function(gobject, #' #' g <- setExpression(gobject = g, x = createExprObj(m, name = "raw")) #' @export -setExpression <- function(gobject, - x, - spat_unit = NULL, - feat_type = NULL, - name = "raw", - provenance = NULL, - verbose = TRUE, - initialize = TRUE) { +setExpression <- function( + gobject, + x, + spat_unit = NULL, + feat_type = NULL, + name = "raw", + provenance = NULL, + verbose = TRUE, + initialize = TRUE, + ...) { assert_giotto(gobject) if (!methods::hasArg(x)) { stop(wrap_txt("x param (data to set) must be given")) @@ -1756,24 +1764,19 @@ setExpression <- function(gobject, #' @param verbose be verbose #' @param initialize (default = FALSE) whether to initialize the gobject before #' returning. Will be set to TRUE when called by the external +#' @keywords internal #' @returns giotto object -#' @family expression accessor functions -#' @family functions to set data in giotto object -#' @export -set_expression_values <- function(gobject, - values, - spat_unit = NULL, - feat_type = NULL, - name = "test", - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE) { - deprecate_soft("3.3.0", - what = "set_expression_values()", - with = "setExpression()" - ) - +#' @noRd +set_expression_values <- function( + gobject, + values, + spat_unit = NULL, + feat_type = NULL, + name = "test", + provenance = NULL, + verbose = TRUE, + set_defaults = TRUE, + initialize = FALSE) { assert_giotto(gobject) if (!inherits(values, c("exprObj", "NULL"))) { @@ -1958,13 +1961,14 @@ set_expression_values <- function(gobject, #' spat_unit = "cell", feat_type = "rna_protein" #' ) #' @export -set_multiomics <- function(gobject, - result, - spat_unit = NULL, - feat_type = NULL, - integration_method = "WNN", - result_name = "theta_weighted_matrix", - verbose = TRUE) { +set_multiomics <- function( + gobject, + result, + spat_unit = NULL, + feat_type = NULL, + integration_method = "WNN", + result_name = "theta_weighted_matrix", + verbose = TRUE) { # 1. determine user input nospec_unit <- ifelse(is.null(spat_unit), yes = TRUE, no = FALSE) nospec_feat <- ifelse(is.null(feat_type), yes = TRUE, no = FALSE) @@ -2024,6 +2028,7 @@ set_multiomics <- function(gobject, #' @param integration_method multiomics integration method used. Default = 'WNN' #' @param result_name Default = 'theta_weighted_matrix' #' @param verbose be verbose +#' @param ... additional params to pass #' #' @returns A giotto object #' @family multiomics accessor functions @@ -2036,13 +2041,15 @@ set_multiomics <- function(gobject, #' spat_unit = "cell", feat_type = "rna_protein" #' ) #' @export -setMultiomics <- function(gobject = NULL, - result, - spat_unit = NULL, - feat_type = NULL, - integration_method = "WNN", - result_name = "theta_weighted_matrix", - verbose = TRUE) { +setMultiomics <- function( + gobject = NULL, + result, + spat_unit = NULL, + feat_type = NULL, + integration_method = "WNN", + result_name = "theta_weighted_matrix", + verbose = TRUE, + ...) { if (!"giotto" %in% class(gobject)) { wrap_msg("Unable to set multiomics info to non-Giotto object.") stop(wrap_txt("Please provide a Giotto object to the gobject argument.", @@ -2085,11 +2092,12 @@ setMultiomics <- function(gobject = NULL, #' #' get_multiomics(gobject = g, spat_unit = "cell", feat_type = "rna_protein") #' @export -get_multiomics <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - integration_method = "WNN", - result_name = "theta_weighted_matrix") { +get_multiomics <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + integration_method = "WNN", + result_name = "theta_weighted_matrix") { # 1. Set feat_type and spat_unit spat_unit <- set_default_spat_unit( @@ -2157,11 +2165,12 @@ get_multiomics <- function(gobject, #' #' getMultiomics(gobject = g, spat_unit = "cell", feat_type = "rna_protein") #' @export -getMultiomics <- function(gobject = NULL, - spat_unit = NULL, - feat_type = NULL, - integration_method = "WNN", - result_name = "theta_weighted_matrix") { +getMultiomics <- function( + gobject = NULL, + spat_unit = NULL, + feat_type = NULL, + integration_method = "WNN", + result_name = "theta_weighted_matrix") { if (!"giotto" %in% class(gobject)) { wrap_msg("Unable to get multiomics info from non-Giotto object.") stop(wrap_msg( @@ -2211,14 +2220,15 @@ getMultiomics <- function(gobject = NULL, #' #' getSpatialLocations(g) #' @export -getSpatialLocations <- function(gobject, - spat_unit = NULL, - name = NULL, - output = c("spatLocsObj", "data.table"), - copy_obj = TRUE, - verbose = TRUE, - set_defaults = TRUE, - simplify = TRUE) { +getSpatialLocations <- function( + gobject, + spat_unit = NULL, + name = NULL, + output = c("spatLocsObj", "data.table"), + copy_obj = TRUE, + verbose = TRUE, + set_defaults = TRUE, + simplify = TRUE) { # Pass to internal function spatloc <- get_spatial_locations( gobject = gobject, @@ -2255,24 +2265,16 @@ getSpatialLocations <- function(gobject, #' @param simplify logical. Whether or not to take object out of a list when #' there is a length of 1. #' @returns data.table with coordinates or spatLocsObj depending on \code{output} -#' @family spatial location data accessor functions -#' @family functions to get data from giotto object -#' @export +#' @noRd get_spatial_locations <- function( - gobject, - spat_unit = NULL, - spat_loc_name = NULL, - output = c("spatLocsObj", "data.table"), - copy_obj = TRUE, - verbose = TRUE, - set_defaults = TRUE, - simplify = TRUE -) { - deprecate_soft("3.3.0", - what = "get_spatial_locations()", - with = "getSpatialLocations()" - ) - + gobject, + spat_unit = NULL, + spat_loc_name = NULL, + output = c("spatLocsObj", "data.table"), + copy_obj = TRUE, + verbose = TRUE, + set_defaults = TRUE, + simplify = TRUE) { output <- match.arg(output, choices = c("spatLocsObj", "data.table")) all_su <- identical(spat_unit, ":all:") @@ -2316,10 +2318,14 @@ get_spatial_locations <- function( su_data <- slotdata[[su]] # if spat_loc_name not given return first available - if (is.null(spat_loc_name)) return(su_data[[1]]) + if (is.null(spat_loc_name)) { + return(su_data[[1]]) + } # directly return if all requested - if (identical(spat_loc_name, ":all:")) return(su_data) + if (identical(spat_loc_name, ":all:")) { + return(su_data) + } # catch non-existing spat_loc_names requested missing_sln <- spat_loc_name[!spat_loc_name %in% objName(su_data)] @@ -2360,12 +2366,13 @@ get_spatial_locations <- function( #' @keywords internal #' @returns list of spatLocsObj or data.tables depending on output param #' @noRd -get_spatial_locations_list <- function(gobject, - spat_unit = NULL, - output = c("spatLocsObj", "data.table"), - copy_obj = TRUE, - verbose = TRUE, - set_defaults = TRUE) { +get_spatial_locations_list <- function( + gobject, + spat_unit = NULL, + output = c("spatLocsObj", "data.table"), + copy_obj = TRUE, + verbose = TRUE, + set_defaults = TRUE) { assert_giotto(gobject) output <- match.arg(output, choices = c("spatLocsObj", "data.table")) @@ -2427,27 +2434,29 @@ get_spatial_locations_list <- function(gobject, #' #' setSpatialLocations(gobject = g, x = createSpatLocsObj(sl, name = "raw")) #' @export -setSpatialLocations <- function(gobject, - x, - spat_unit = NULL, - name = "raw", - provenance = NULL, - verbose = TRUE, - initialize = TRUE) { +setSpatialLocations <- function( + gobject, + x, + spat_unit = NULL, + name = "raw", + provenance = NULL, + verbose = TRUE, + initialize = TRUE, + ...) { checkmate::assert_class(gobject, "giotto") if (!methods::hasArg(x)) { stop(wrap_txt("x (data to set) param must be given")) } - # check hierarchical slots - avail_ex <- list_expression(gobject) - avail_si <- list_spatial_info(gobject) - if (is.null(avail_ex) & is.null(avail_si)) { - stop(wrap_txt("Add expression or spatial (polygon) information first")) + if (getOption("giotto.check_valid", TRUE)) { + avail_ex <- list_expression(gobject) + avail_si <- list_spatial_info(gobject) + if (is.null(avail_ex) && is.null(avail_si)) { + stop(wrap_txt("Add expression or spatial (polygon) information first")) + } } - # 1. Determine user inputs nospec_unit <- ifelse(is.null(spat_unit), yes = TRUE, no = FALSE) nospec_name <- ifelse(is.null(match.call()$name), yes = TRUE, no = FALSE) @@ -2530,22 +2539,16 @@ setSpatialLocations <- function(gobject, #' the \code{spatLocsObj} will be nested by spat_unit 'nucleus' instead and #' its spat_unit slot will be changed to 'nucleus' #' @returns giotto object -#' @family spatial location data accessor functions -#' @family functions to set data in giotto object -#' @export -set_spatial_locations <- function(gobject, - spatlocs, - spat_unit = NULL, - spat_loc_name = "raw", - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE) { - deprecate_soft("3.3.0", - what = "set_spatial_locations()", - with = "setSpatialLocations()" - ) - +#' @noRd +set_spatial_locations <- function( + gobject, + spatlocs, + spat_unit = NULL, + spat_loc_name = "raw", + provenance = NULL, + verbose = TRUE, + set_defaults = TRUE, + initialize = FALSE) { assert_giotto(gobject) if (!methods::hasArg(spatlocs)) { stop(wrap_txt("spatlocs param must be given")) @@ -2664,29 +2667,33 @@ set_spatial_locations <- function(gobject, #' @param output object type to return as. Either 'dimObj' (default) or 'matrix' #' of the embedding coordinates. #' @description Function to get a dimension reduction object +#' @keywords internal #' @returns dim reduction object (default) or dim reduction coordinates -#' @family dimensional reduction data accessor functions -#' @family functions to get data from giotto object -#' @export -get_dimReduction <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - reduction = c("cells", "feats"), - reduction_method = c("pca", "umap", "tsne"), - name = "pca", - output = c("dimObj", "matrix"), - set_defaults = TRUE) { - deprecate_soft(when = "3.3.0", "get_dimReduction()", "getDimReduction()") - - assert_giotto(gobject) +#' @noRd +get_dimReduction <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + reduction = c("cells", "feats"), + reduction_method = NULL, + name = NULL, + output = c("dimObj", "matrix"), + set_defaults = TRUE) { + checkmate::assert_class(gobject, "giotto") # to be deprecated ('data.table' -> 'matrix') if (!identical(output, c("dimObj", "matrix"))) { if (output == "data.table") output <- "matrix" } + ## check parameters output <- match.arg(output, choices = c("dimObj", "matrix")) + reduction <- match.arg(arg = reduction, choices = c("cells", "feats")) + reduction_method <- match.arg( + arg = reduction_method, + choices = unique(c("pca", "umap", "tsne", reduction_method)) + ) - # Set feat_type and spat_unit + # 1. Set feat_type and spat_unit if (isTRUE(set_defaults)) { spat_unit <- set_default_spat_unit( gobject = gobject, @@ -2699,37 +2706,35 @@ get_dimReduction <- function(gobject, ) } - ## check parameters - reduction <- match.arg(arg = reduction, choices = c("cells", "feats")) - reduction_method <- match.arg( - arg = reduction_method, - choices = unique(c("pca", "umap", "tsne", reduction_method)) + # 2. Find object + potential_drs <- list_dim_reductions_names( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + data_type = reduction, + dim_type = reduction_method ) - ## check reduction - reduction_res <- slot(gobject, "dimension_reduction")[[reduction]][[spat_unit]][[feat_type]] - if (is.null(reduction_res)) { - stop("No dimension reduction for ", reduction, " has been applied \n") - } - - ## check method - reduction_res <- reduction_res[[reduction_method]] - if (is.null(reduction_res)) { - stop(reduction_method, " has not been performed on this dataset \n") + if (is.null(name)) name <- potential_drs[[1L]] + if (is.null(name)) { + stop(wrap_txt(sprintf( + "No dimension reduction for \"%s\" has been applied\n", reduction + )), call. = FALSE) } - ## check name for method - reduction_res <- reduction_res[[name]] - if (is.null(reduction_res)) { - stop( - name, ": this name is not available for method: ", - reduction_method, "\n" - ) + if (!name %in% potential_drs) { + stop(wrap_txt( + errWidth = TRUE, + "Requested dimension reduction not found", + sprintf( + "[spat_unit:\"%s\"] [feat_type:\"%s\"] [name: \"%s\"]", + spat_unit, feat_type, name + ) + )) } - ## S3 backwards compatibility - if (!isS4(reduction_res)) reduction_res <- S3toS4dimObj(reduction_res) - silent <- validObject(reduction_res) # variable hides TRUE print + # get info from slot nesting + reduction_res <- gobject@dimension_reduction[[reduction]][[spat_unit]][[feat_type]][[reduction_method]][[name]] ## return object or coordinates if (output == "dimObj") { @@ -2760,14 +2765,15 @@ get_dimReduction <- function(gobject, #' #' getDimReduction(g) #' @export -getDimReduction <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - reduction = c("cells", "feats"), - reduction_method = c("pca", "umap", "tsne"), - name = "pca", - output = c("dimObj", "matrix"), - set_defaults = TRUE) { +getDimReduction <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + reduction = c("cells", "feats"), + reduction_method = NULL, + name = NULL, + output = c("dimObj", "matrix"), + set_defaults = TRUE) { # pass to internal dimRed <- get_dimReduction( gobject = gobject, @@ -2795,12 +2801,13 @@ getDimReduction <- function(gobject, #' @keywords internal #' @return list of dimObj or matrix depending on output param #' @noRd -get_dim_reduction_list <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - reduction = c("cells", "feats"), - output = c("dimObj", "matrix"), - set_defaults = TRUE) { +get_dim_reduction_list <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + reduction = c("cells", "feats"), + output = c("dimObj", "matrix"), + set_defaults = TRUE) { assert_giotto(gobject) reduction <- match.arg(reduction, choices = c("cells", "feats")) @@ -2864,16 +2871,18 @@ get_dim_reduction_list <- function(gobject, #' #' setDimReduction(gobject = g, x = dimred) #' @export -setDimReduction <- function(gobject, - x, - spat_unit = NULL, - feat_type = NULL, - name = "pca", - reduction = c("cells", "feats"), - reduction_method = c("pca", "umap", "tsne"), - provenance = NULL, - verbose = TRUE, - initialize = TRUE) { +setDimReduction <- function( + gobject, + x, + spat_unit = NULL, + feat_type = NULL, + name = "pca", + reduction = c("cells", "feats"), + reduction_method = c("pca", "umap", "tsne"), + provenance = NULL, + verbose = TRUE, + initialize = TRUE, + ...) { assert_giotto(gobject) reduction <- match.arg(reduction, choices = c("cells", "feats")) # reduction_method = match.arg(reduction_method, @@ -2882,12 +2891,11 @@ setDimReduction <- function(gobject, stop(wrap_txt("x (data to set) param must be given")) } - # check hierarchical slots - avail_ex <- list_expression(gobject) - if (is.null(avail_ex)) stop(wrap_txt("Add expression information first")) - - + if (getOption("giotto.check_valid", TRUE)) { + avail_ex <- list_expression(gobject) + if (is.null(avail_ex)) stop(wrap_txt("Add expression information first")) + } # 1. Determine user inputs nospec_unit <- ifelse(is.null(spat_unit), yes = TRUE, no = FALSE) @@ -2976,26 +2984,21 @@ setDimReduction <- function(gobject, #' @param dimObject dimension object result to set #' @param provenance provenance information (optional) #' @param verbose be verbose +#' @keywords internal #' @returns giotto object -#' @family dimensional reduction data accessor functions -#' @family functions to set data in giotto object -#' @export -set_dimReduction <- function(gobject, - dimObject, - spat_unit = NULL, - feat_type = NULL, - reduction = c("cells", "feats"), - reduction_method = c("pca", "umap", "tsne"), - name = "pca", - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE) { - deprecate_soft("3.3.0", - what = "set_dimReduction()", - with = "setDimReduction()" - ) - +#' @noRd +set_dimReduction <- function( + gobject, + dimObject, + spat_unit = NULL, + feat_type = NULL, + reduction = c("cells", "feats"), + reduction_method = c("pca", "umap", "tsne"), + name = "pca", + provenance = NULL, + verbose = TRUE, + set_defaults = TRUE, + initialize = FALSE) { assert_giotto(gobject) reduction <- match.arg(reduction, choices = c("cells", "feats")) # reduction_method = match.arg(reduction_method, @@ -3150,21 +3153,15 @@ set_dimReduction <- function(gobject, #' @param network_name name of NN network to be used #' @param output return a igraph or data.table object. Default 'igraph' #' @returns igraph or data.table object -#' @family expression space nearest network accessor functions -#' @family functions to get data from giotto object -#' @export -get_NearestNetwork <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - nn_network_to_use = NULL, - network_name = NULL, - output = c("nnNetObj", "igraph", "data.table"), - set_defaults = TRUE) { - deprecate_soft( - when = "3.3.0", what = "get_NearestNetwork()", - with = "getNearestNetwork()" - ) - +#' @noRd +get_NearestNetwork <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + nn_network_to_use = NULL, + network_name = NULL, + output = c("nnNetObj", "igraph", "data.table"), + set_defaults = TRUE) { output <- match.arg( arg = output, choices = c("nnNetObj", "igraph", "data.table") @@ -3257,7 +3254,7 @@ get_NearestNetwork <- function(gobject, #' @inheritParams data_access_params #' @param nn_type "kNN" or "sNN" #' @param name name of NN network to be used -#' @param output return a giotto `nnNetObj`, `igraph`, `data.table` object. +#' @param output return a giotto `nnNetObj`, `igraph`, `data.table` object. #' Default 'nnNetObj' #' @returns Giotto `nnNetObj`, `igraph` or `data.table` object #' @family expression space nearest network accessor functions @@ -3267,13 +3264,14 @@ get_NearestNetwork <- function(gobject, #' #' getNearestNetwork(gobject = g) #' @export -getNearestNetwork <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - nn_type = NULL, - name = NULL, - output = c("nnNetObj", "igraph", "data.table"), - set_defaults = TRUE) { +getNearestNetwork <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + nn_type = NULL, + name = NULL, + output = c("nnNetObj", "igraph", "data.table"), + set_defaults = TRUE) { # pass to internal nn <- get_NearestNetwork( gobject = gobject, @@ -3298,11 +3296,12 @@ getNearestNetwork <- function(gobject, #' @keywords internal #' @return list of nnNetObj, igraph, or data.table depending on output param #' @noRd -get_nearest_network_list <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - output = c("nnNetObj", "igraph", "data.table"), - set_defaults = TRUE) { +get_nearest_network_list <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + output = c("nnNetObj", "igraph", "data.table"), + set_defaults = TRUE) { checkmate::assert_class(gobject, classes = "giotto") output <- match.arg(output, choices = c("nnNetObj", "igraph", "data.table")) @@ -3364,28 +3363,30 @@ get_nearest_network_list <- function(gobject, #' #' setNearestNetwork(gobject = g, x = dimred) #' @export -setNearestNetwork <- function(gobject, - x, - spat_unit = NULL, - feat_type = NULL, - nn_type = "sNN", - name = "sNN.pca", - provenance = NULL, - verbose = TRUE, - initialize = TRUE) { +setNearestNetwork <- function( + gobject, + x, + spat_unit = NULL, + feat_type = NULL, + nn_type = "sNN", + name = "sNN.pca", + provenance = NULL, + verbose = TRUE, + initialize = TRUE, + ...) { assert_giotto(gobject) if (!methods::hasArg(x)) { stop(wrap_txt("x (data to set) param must be given")) } - # check hierarchical slots - avail_dr <- list_dim_reductions(gobject) - if (is.null(avail_dr)) { - stop(wrap_txt("Add dimension reduction information first")) + if (getOption("giotto.check_valid", TRUE)) { + avail_dr <- list_dim_reductions(gobject) + if (is.null(avail_dr)) { + stop(wrap_txt("Add dimension reduction information first")) + } } - # 1. Determine user inputs nospec_unit <- ifelse(is.null(spat_unit), yes = TRUE, no = FALSE) nospec_feat <- ifelse(is.null(feat_type), yes = TRUE, no = FALSE) @@ -3463,27 +3464,22 @@ setNearestNetwork <- function(gobject, #' @param network_name name of NN network to be used #' @param nn_network nnNetObj or igraph nearest network object. Data.table not #' yet supported. -#' @param provenance provenance information (optional) -#' @param verbose be verbose -#' @returns giotto object -#' @family expression space nearest network accessor functions -#' @family functions to set data in giotto object -#' @export -set_NearestNetwork <- function(gobject, - nn_network, - spat_unit = NULL, - feat_type = NULL, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE) { - deprecate_soft("3.3.0", - what = "set_NearestNetwork()", - with = "setNearestNetwork()" - ) - +#' @param provenance provenance information (optional) +#' @param verbose be verbose +#' @returns giotto object +#' @keywords internal +#' @noRd +set_NearestNetwork <- function( + gobject, + nn_network, + spat_unit = NULL, + feat_type = NULL, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + provenance = NULL, + verbose = TRUE, + set_defaults = TRUE, + initialize = FALSE) { assert_giotto(gobject) if (!methods::hasArg(nn_network)) { stop(wrap_txt("nn_network param must be given")) @@ -3623,28 +3619,21 @@ set_NearestNetwork <- function(gobject, #' @param simplify logical. Whether or not to take object out of a list when #' there is a length of 1. #' @returns spatialNetworkObj of data.table -#' @family spatial network data accessor functions -#' @family functions to get data from giotto object -#' @export -get_spatialNetwork <- function(gobject, - spat_unit = NULL, - name = NULL, - output = c( - "spatialNetworkObj", - "networkDT", - "networkDT_before_filter", - "outputObj" - ), - set_defaults = TRUE, - copy_obj = TRUE, - verbose = TRUE, - simplify = TRUE -) { - deprecate_soft("3.3.0", - what = "get_spatialNetwork()", - with = "getSpatialNetwork()" - ) - +#' @noRd +get_spatialNetwork <- function( + gobject, + spat_unit = NULL, + name = NULL, + output = c( + "spatialNetworkObj", + "networkDT", + "networkDT_before_filter", + "outputObj" + ), + set_defaults = TRUE, + copy_obj = TRUE, + verbose = TRUE, + simplify = TRUE) { output <- match.arg(output, choices = c( "spatialNetworkObj", "networkDT", @@ -3679,7 +3668,7 @@ get_spatialNetwork <- function(gobject, stop(wrap_txt(sprintf( "No %ss for spat_unit(s): '%s'", data_type, paste(missing_su, collapse = "', '") - ), errWidth = TRUE),call. = FALSE) + ), errWidth = TRUE), call. = FALSE) } # subset to requested spat_units @@ -3694,10 +3683,14 @@ get_spatialNetwork <- function(gobject, su_data <- slotdata[[su]] # if name not given, return first available - if (is.null(name)) return(su_data[[1L]]) + if (is.null(name)) { + return(su_data[[1L]]) + } # directly return if all requested - if (identical(name, ":all:")) return(su_data) + if (identical(name, ":all:")) { + return(su_data) + } # catch non-existing names requested missing_snn <- name[!name %in% objName(su_data)] @@ -3764,19 +3757,20 @@ get_spatialNetwork <- function(gobject, #' #' getSpatialNetwork(g) #' @export -getSpatialNetwork <- function(gobject, - spat_unit = NULL, - name = NULL, - output = c( - "spatialNetworkObj", - "networkDT", - "networkDT_before_filter", - "outputObj" - ), - set_defaults = TRUE, - copy_obj = TRUE, - verbose = TRUE, - simplify = TRUE) { +getSpatialNetwork <- function( + gobject, + spat_unit = NULL, + name = NULL, + output = c( + "spatialNetworkObj", + "networkDT", + "networkDT_before_filter", + "outputObj" + ), + set_defaults = TRUE, + copy_obj = TRUE, + verbose = TRUE, + simplify = TRUE) { # Pass to internal function network <- get_spatialNetwork( gobject = gobject, @@ -3801,16 +3795,17 @@ getSpatialNetwork <- function(gobject, #' @keywords internal #' @return list of dimObj or data.table depending on output param #' @noRd -get_spatial_network_list <- function(gobject, - spat_unit = NULL, - output = c( - "spatialNetworkObj", - "networkDT", - "networkDT_before_filter", - "outputObj" - ), - set_defaults = TRUE, - copy_obj = TRUE) { +get_spatial_network_list <- function( + gobject, + spat_unit = NULL, + output = c( + "spatialNetworkObj", + "networkDT", + "networkDT_before_filter", + "outputObj" + ), + set_defaults = TRUE, + copy_obj = TRUE) { checkmate::assert_class(gobject, "giotto") output <- match.arg(output, choices = c( @@ -3878,13 +3873,15 @@ get_spatial_network_list <- function(gobject, #' #' setSpatialNetwork(gobject = g, x = spatnet) #' @export -setSpatialNetwork <- function(gobject, - x, - spat_unit = NULL, - name = NULL, - provenance = NULL, - verbose = TRUE, - initialize = TRUE) { +setSpatialNetwork <- function( + gobject, + x, + spat_unit = NULL, + name = NULL, + provenance = NULL, + verbose = TRUE, + initialize = TRUE, + ...) { assert_giotto(gobject) if (!methods::hasArg(x)) { stop(wrap_txt("x param (data to set) must be given")) @@ -3892,13 +3889,11 @@ setSpatialNetwork <- function(gobject, # check hierarchical slots - avail_ex <- list_expression(gobject) - avail_sl <- list_spatial_locations(gobject) - if (is.null(avail_ex)) { - stop(wrap_txt("Add expression and spatial location information first")) - } - if (is.null(avail_sl)) { - stop(wrap_txt("Add spatial location information first")) + if (getOption("giotto.check_valid", TRUE)) { + avail_sl <- list_spatial_locations(gobject) + if (is.null(avail_sl)) { + stop(wrap_txt("Add spatial location information first")) + } } @@ -3974,22 +3969,16 @@ setSpatialNetwork <- function(gobject, #' @param spatial_network spatial network #' @param verbose be verbose #' @returns giotto object -#' @family spatial network data accessor functions -#' @family functions to set data in giotto object -#' @export -set_spatialNetwork <- function(gobject, - spatial_network, - spat_unit = NULL, - name = NULL, - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE) { - deprecate_soft("3.3.0", - what = "set_spatialNetwork()", - with = "setSpatialNetwork()" - ) - +#' @noRd +set_spatialNetwork <- function( + gobject, + spatial_network, + spat_unit = NULL, + name = NULL, + provenance = NULL, + verbose = TRUE, + set_defaults = TRUE, + initialize = FALSE) { assert_giotto(gobject) if (!methods::hasArg(spatial_network)) { stop(wrap_txt("spatial_network param must be given")) @@ -4102,20 +4091,14 @@ set_spatialNetwork <- function(gobject, #' @param name name of spatial grid #' @param return_grid_Obj return grid object (default = FALSE) #' @returns spatialGridObj -#' @family spatial grid data accessor functions -#' @family functions to get data from giotto object -#' @export -get_spatialGrid <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - name = NULL, - return_grid_Obj = FALSE, - set_defaults = TRUE) { - deprecate_soft("3.3.0", - what = "get_spatialGrid()", - with = "getSpatialGrid()" - ) - +#' @noRd +get_spatialGrid <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + name = NULL, + return_grid_Obj = FALSE, + set_defaults = TRUE) { # Set feat_type and spat_unit if (isTRUE(set_defaults)) { spat_unit <- set_default_spat_unit( @@ -4223,12 +4206,13 @@ get_spatialGrid <- function(gobject, #' #' getSpatialGrid(g) #' @export -getSpatialGrid <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - name = NULL, - return_grid_Obj = FALSE, - set_defaults = TRUE) { +getSpatialGrid <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + name = NULL, + return_grid_Obj = FALSE, + set_defaults = TRUE) { # Pass to internal function grid <- get_spatialGrid( gobject = gobject, @@ -4250,21 +4234,15 @@ getSpatialGrid <- function(gobject, #' @param name name of spatial grid #' @param verbose be verbose #' @returns giotto object -#' @family spatial grid data accessor functions -#' @family functions to set data in giotto object -#' @export -set_spatialGrid <- function(gobject, - spatial_grid, - spat_unit = NULL, - feat_type = NULL, - name = NULL, - verbose = TRUE, - set_defaults = TRUE) { - deprecate_soft("3.3.0", - what = "set_spatialGrid()", - with = "setSpatialGrid()" - ) - +#' @noRd +set_spatialGrid <- function( + gobject, + spatial_grid, + spat_unit = NULL, + feat_type = NULL, + name = NULL, + verbose = TRUE, + set_defaults = TRUE) { # 1. check input nospec_unit <- ifelse(is.null(spat_unit), yes = TRUE, no = FALSE) nospec_feat <- ifelse(is.null(feat_type), yes = TRUE, no = FALSE) @@ -4362,13 +4340,15 @@ set_spatialGrid <- function(gobject, #' #' setSpatialGrid(gobject = g, spatial_grid = sg) #' @export -setSpatialGrid <- function(gobject, - spatial_grid, - spat_unit = NULL, - feat_type = NULL, - name = NULL, - verbose = TRUE, - set_defaults = TRUE) { +setSpatialGrid <- function( + gobject, + spatial_grid, + spat_unit = NULL, + feat_type = NULL, + name = NULL, + verbose = TRUE, + set_defaults = TRUE, + ...) { # Pass to internal function gobject <- set_spatialGrid( gobject = gobject, @@ -4398,21 +4378,14 @@ setSpatialGrid <- function(gobject, #' @param simplify logical. Whether or not to take object out of a list when #' there is a length of 1. #' @returns spatVector -#' @family polygon info data accessor functions -#' @family functions to get data from giotto object -#' @export -get_polygon_info <- function(gobject, - polygon_name = NULL, - polygon_overlap = NULL, - return_giottoPolygon = FALSE, - verbose = TRUE, - simplify = TRUE -) { - deprecate_soft("3.3.0", - what = "get_polygon_info()", - with = "getPolygonInfo()" - ) - +#' @noRd +get_polygon_info <- function( + gobject, + polygon_name = NULL, + polygon_overlap = NULL, + return_giottoPolygon = FALSE, + verbose = TRUE, + simplify = TRUE) { slotdata <- slot(gobject, "spatial_info") potential_names <- names(slotdata) @@ -4441,7 +4414,8 @@ get_polygon_info <- function(gobject, if (length(missing_p) > 0L && !all_p) { stop(wrap_txtf( "No polygon information with name(s): '%s'", - paste(missing_p, collapse = "', '"), errWidth = TRUE + paste(missing_p, collapse = "', '"), + errWidth = TRUE ), call. = FALSE) } @@ -4464,7 +4438,8 @@ get_polygon_info <- function(gobject, if (!polygon_overlap %in% potential_overlaps) { stop(wrap_txtf( "There is no polygon overlap information with name", - polygon_overlap, errWidth = TRUE + polygon_overlap, + errWidth = TRUE ), call. = FALSE) } return(ovlp_data[[polygon_overlap]]) @@ -4501,12 +4476,13 @@ get_polygon_info <- function(gobject, #' #' getPolygonInfo(g) #' @export -getPolygonInfo <- function(gobject = NULL, - polygon_name = NULL, - polygon_overlap = NULL, - return_giottoPolygon = FALSE, - verbose = TRUE, - simplify = TRUE) { +getPolygonInfo <- function( + gobject = NULL, + polygon_name = NULL, + polygon_overlap = NULL, + return_giottoPolygon = FALSE, + verbose = TRUE, + simplify = TRUE) { if (!inherits(gobject, "giotto")) { wrap_msg("Unable to get polygon spatVector from non-Giotto object.") stop(wrap_txt("Please provide a Giotto object to the gobject argument.", @@ -4534,8 +4510,9 @@ getPolygonInfo <- function(gobject = NULL, #' @return list of giottoPolygon or SpatVector depending on return_giottoPolygon #' param #' @noRd -get_polygon_info_list <- function(gobject, - return_giottoPolygon = TRUE) { +get_polygon_info_list <- function( + gobject, + return_giottoPolygon = TRUE) { assert_giotto(gobject) data_list <- slot(gobject, "spatial_info") @@ -4581,12 +4558,14 @@ get_polygon_info_list <- function(gobject, #' #' setPolygonInfo(gobject = g, x = polyinfo) #' @export -setPolygonInfo <- function(gobject, - x, - name = "cell", - centroids_to_spatlocs = FALSE, - verbose = TRUE, - initialize = TRUE) { +setPolygonInfo <- function( + gobject, + x, + name = "cell", + centroids_to_spatlocs = FALSE, + verbose = TRUE, + initialize = TRUE, + ...) { # data.table vars poly_ID <- y <- NULL @@ -4736,19 +4715,13 @@ setPolygonInfo <- function(gobject, #' @param gpolygon giottoPolygon object #' @param verbose be verbose #' @returns giotto object -#' @family polygon info data accessor functions -#' @family functions to set data in giotto object -#' @export -set_polygon_info <- function(gobject, - gpolygon, - polygon_name = "cell", - verbose = TRUE, - initialize = FALSE) { - deprecate_soft("3.3.0", - what = "set_polygon_info()", - with = "setPolygonInfo()" - ) - +#' @noRd +set_polygon_info <- function( + gobject, + gpolygon, + polygon_name = "cell", + verbose = TRUE, + initialize = FALSE) { assert_giotto(gobject) if (!methods::hasArg(gpolygon)) { stop(wrap_txt("gpolygon param must be given")) @@ -4910,11 +4883,12 @@ set_polygon_info <- function(gobject, #' #' getFeatureInfo(g) #' @export -getFeatureInfo <- function(gobject = gobject, - feat_type = NULL, - return_giottoPoints = FALSE, - set_defaults = TRUE, - simplify = TRUE) { +getFeatureInfo <- function( + gobject = gobject, + feat_type = NULL, + return_giottoPoints = FALSE, + set_defaults = TRUE, + simplify = TRUE) { if (!inherits(gobject, "giotto")) { wrap_msg("Unable to get giotto points spatVector feature info from non-Giotto object.") @@ -4941,18 +4915,13 @@ getFeatureInfo <- function(gobject = gobject, #' @description Get giotto points spatVector #' @returns a SpatVector (default) or giottoPoints object depending on value of #' return_giottoPoints -#' @family feature info data accessor functions -#' @family functions to get data from giotto object -#' @export -get_feature_info <- function(gobject, - feat_type = NULL, - set_defaults = TRUE, - return_giottoPoints = FALSE, - simplify = TRUE) { - deprecate_soft("3.3.0", - what = "get_feature_info()", - with = "getFeatureInfo()" - ) +#' @noRd +get_feature_info <- function( + gobject, + feat_type = NULL, + set_defaults = TRUE, + return_giottoPoints = FALSE, + simplify = TRUE) { checkmate::assert_class(gobject, "giotto") # specify feat_type @@ -4969,7 +4938,8 @@ get_feature_info <- function(gobject, if (is.null(potential_names)) { stop("Giotto object contains no feature point information", - call. = FALSE) + call. = FALSE + ) } all_fi <- identical(feat_type, ":all:") @@ -4978,7 +4948,8 @@ get_feature_info <- function(gobject, if (length(missing_p) > 0L && !all_fi) { stop(wrap_txtf( "No feature point information with name '%s'", - paste(missing_p, collapse = "', '"), errWidth = TRUE + paste(missing_p, collapse = "', '"), + errWidth = TRUE ), call. = FALSE) } @@ -5010,8 +4981,9 @@ get_feature_info <- function(gobject, #' @return list of giottoPoints or SpatVector depending on return_giottoPoints #' param #' @noRd -get_feature_info_list <- function(gobject, - return_giottoPoints = TRUE) { +get_feature_info_list <- function( + gobject, + return_giottoPoints = TRUE) { assert_giotto(gobject) data_list <- slot(gobject, "feat_info") @@ -5045,11 +5017,13 @@ get_feature_info_list <- function(gobject, #' #' setFeatureInfo(gobject = g, x = featinfo) #' @export -setFeatureInfo <- function(gobject, - x, - feat_type = NULL, - verbose = TRUE, - initialize = TRUE) { +setFeatureInfo <- function( + gobject, + x, + feat_type = NULL, + verbose = TRUE, + initialize = TRUE, + ...) { assert_giotto(gobject) if (!methods::hasArg(x)) { stop(wrap_txt("x param (data to set) must be given")) @@ -5125,21 +5099,15 @@ setFeatureInfo <- function(gobject, #' @param gpolygon typo do not use #' @param verbose be verbose #' @returns giotto object -#' @family feature info data accessor functions -#' @family functions to set data in giotto object -#' @export -set_feature_info <- function(gobject, - gpoints, - feat_type = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE, - gpolygon = NULL) { - deprecate_soft("3.3.0", - what = "set_feature_info()", - with = "setFeatureInfo()" - ) - +#' @noRd +set_feature_info <- function( + gobject, + gpoints, + feat_type = NULL, + verbose = TRUE, + set_defaults = TRUE, + initialize = FALSE, + gpolygon = NULL) { assert_giotto(gobject) if (!methods::hasArg(gpoints) & !methods::hasArg(gpolygon)) { stop(wrap_txt("gpoints param must be given")) @@ -5297,21 +5265,15 @@ set_feature_info <- function(gobject, #' @inheritParams data_access_params #' @param enrichm_name name of spatial enrichment results. Default "DWLS" #' @returns spatEnrObj or data.table with fractions -#' @family spatial enrichment data accessor functions -#' @family functions to get data from giotto object -#' @export -get_spatial_enrichment <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - enrichm_name = "DWLS", - output = c("spatEnrObj", "data.table"), - copy_obj = TRUE, - set_defaults = TRUE) { - deprecate_soft("3.3.0", - what = "get_spatial_enrichment()", - with = "getSpatialEnrichment()" - ) - +#' @noRd +get_spatial_enrichment <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + enrichm_name = "DWLS", + output = c("spatEnrObj", "data.table"), + copy_obj = TRUE, + set_defaults = TRUE) { output <- match.arg(output, choices = c("spatEnrObj", "data.table")) # Set feat_type and spat_unit @@ -5390,13 +5352,14 @@ get_spatial_enrichment <- function(gobject, #' #' getSpatialEnrichment(g, spat_unit = "aggregate", name = "cluster_metagene") #' @export -getSpatialEnrichment <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - name = "DWLS", - output = c("spatEnrObj", "data.table"), - copy_obj = TRUE, - set_defaults = TRUE) { +getSpatialEnrichment <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + name = "DWLS", + output = c("spatEnrObj", "data.table"), + copy_obj = TRUE, + set_defaults = TRUE) { # Pass to internal function enr_res <- get_spatial_enrichment( gobject = gobject, @@ -5420,12 +5383,13 @@ getSpatialEnrichment <- function(gobject, #' @keywords internal #' @returns list of spatEnrObj or data.table depending on output param #' @noRd -get_spatial_enrichment_list <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - output = c("spatEnrObj", "data.table"), - copy_obj = TRUE, - set_defaults = TRUE) { +get_spatial_enrichment_list <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + output = c("spatEnrObj", "data.table"), + copy_obj = TRUE, + set_defaults = TRUE) { assert_giotto(gobject) output <- match.arg(output, choices = c("spatEnrObj", "data.table")) @@ -5480,27 +5444,31 @@ get_spatial_enrichment_list <- function(gobject, #' #' g <- setSpatialEnrichment(g, spatenrich) #' @export -setSpatialEnrichment <- function(gobject, - x, - spat_unit = NULL, - feat_type = NULL, - name = "enrichment", - provenance = NULL, - verbose = TRUE, - initialize = TRUE) { +setSpatialEnrichment <- function( + gobject, + x, + spat_unit = NULL, + feat_type = NULL, + name = "enrichment", + provenance = NULL, + verbose = TRUE, + initialize = TRUE, + ...) { assert_giotto(gobject) if (!methods::hasArg(x)) { stop(wrap_txt("x param (data to set) must be given")) } # check hierarchical slots - avail_ex <- list_expression(gobject) - avail_sl <- list_spatial_locations(gobject) - if (is.null(avail_ex)) { - stop(wrap_txt("Add expression and spatial information first")) - } - if (is.null(avail_sl)) { - stop(wrap_txt("Add spatial location information first")) + if (getOption("giotto.check_valid", TRUE)) { + avail_ex <- list_expression(gobject) + avail_sl <- list_spatial_locations(gobject) + if (is.null(avail_ex)) { + stop(wrap_txt("Add expression and spatial information first")) + } + if (is.null(avail_sl)) { + stop(wrap_txt("Add spatial location information first")) + } } # 1. determine user inputs @@ -5575,23 +5543,17 @@ setSpatialEnrichment <- function(gobject, #' @param provenance provenance information (optional) #' @param verbose be verbose #' @returns giotto object -#' @family spatial enrichment data accessor functions -#' @family functions to set data in giotto object -#' @export -set_spatial_enrichment <- function(gobject, - spatenrichment, - spat_unit = NULL, - feat_type = NULL, - enrichm_name = "enrichment", - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE) { - deprecate_soft("3.3.0", - what = "set_spatial_enrichment()", - with = "setSpatialEnrichment()" - ) - +#' @noRd +set_spatial_enrichment <- function( + gobject, + spatenrichment, + spat_unit = NULL, + feat_type = NULL, + enrichm_name = "enrichment", + provenance = NULL, + verbose = TRUE, + set_defaults = TRUE, + initialize = FALSE) { assert_giotto(gobject) if (!methods::hasArg(spatenrichment)) { stop(wrap_txt("spatenrichment param must be given")) @@ -5719,8 +5681,10 @@ set_spatial_enrichment <- function(gobject, #' @param name name of giottoImage \code{\link{showGiottoImageNames}} #' @returns a giottoImage #' @keywords internal -get_giottoImage_MG <- function(gobject, - name = NULL) { +#' @noRd +get_giottoImage_MG <- function( + gobject, + name = NULL) { g_image_names <- list_images(gobject, img_type = "image") if (is.null(g_image_names)) stop("No giottoImages have been found \n") @@ -5752,10 +5716,12 @@ get_giottoImage_MG <- function(gobject, #' @param verbose be verbose #' @returns giotto object #' @keywords internal -set_giottoImage_MG <- function(gobject, - image_object, - name = NULL, - verbose = NULL) { +#' @noRd +set_giottoImage_MG <- function( + gobject, + image_object, + name = NULL, + verbose = NULL) { # Check params if (is.null(image_object)) { stop("`image_object` to be attached must be given \n", call. = FALSE) @@ -5791,8 +5757,10 @@ set_giottoImage_MG <- function(gobject, #' @param name name of giottoLargeImage \code{\link{showGiottoImageNames}} #' @returns a giottoLargeImage #' @keywords internal -get_giottoLargeImage <- function(gobject, - name = NULL) { +#' @noRd +get_giottoLargeImage <- function( + gobject, + name = NULL) { g_image_names <- list_images(gobject, img_type = "largeImage") if (is.null(g_image_names)) { stop("No giottoLargeImages have been found \n") @@ -5824,10 +5792,12 @@ get_giottoLargeImage <- function(gobject, #' @param verbose be verbose #' @returns giotto object #' @keywords internal -set_giottoLargeImage <- function(gobject, - largeImage_object, - name = NULL, - verbose = NULL) { +#' @noRd +set_giottoLargeImage <- function( + gobject, + largeImage_object, + name = NULL, + verbose = NULL) { # Check params if (is.null(largeImage_object)) { stop("largeImage_object to be attached must be given\n") @@ -5865,17 +5835,11 @@ set_giottoLargeImage <- function(gobject, #' @param image_type deprecated #' @param name name of a giotto image object \code{\link{showGiottoImageNames}} #' @returns a giotto image object -#' @family image data accessor functions -#' @family functions to get data from giotto object -#' @export -get_giottoImage <- function(gobject = NULL, - image_type = NULL, - name = NULL) { - deprecate_soft("3.3.0", - what = "get_giottoImage()", - with = "getGiottoImage()" - ) - +#' @noRd +get_giottoImage <- function( + gobject = NULL, + image_type = NULL, + name = NULL) { gimg <- getGiottoImage(gobject = gobject, name = name) return(gimg) @@ -5896,9 +5860,10 @@ get_giottoImage <- function(gobject = NULL, #' #' getGiottoImage(gobject = g) #' @export -getGiottoImage <- function(gobject, - image_type = NULL, - name = NULL) { +getGiottoImage <- function( + gobject, + image_type = NULL, + name = NULL) { if (!inherits(gobject, "giotto")) { wrap_msg("Unable to get Giotto Image from non-Giotto object.") stop(wrap_txt("Please provide a Giotto object to the gobject argument.", @@ -5941,8 +5906,9 @@ getGiottoImage <- function(gobject, #' @description Get list of all giottoImages #' @keywords internal #' @noRd -get_giotto_image_list <- function(gobject, - image_type = NULL) { +get_giotto_image_list <- function( + gobject, + image_type = NULL) { checkmate::assert_class(gobject, "giotto") return( @@ -5973,20 +5939,13 @@ get_giotto_image_list <- function(gobject, #' @param name name of giotto image object #' @param verbose be verbose #' @returns giotto object -#' @family image data accessor functions -#' @family functions to set data in giotto object -#' @seealso \code{\link{addGiottoImage}} -#' @export -set_giottoImage <- function(gobject = NULL, - image = NULL, - image_type = NULL, - name = NULL, - verbose = TRUE) { - deprecate_soft("3.3.0", - what = "set_giottoImage()", - with = "setGiottoImage()" - ) - +#' @noRd +set_giottoImage <- function( + gobject = NULL, + image = NULL, + image_type = NULL, + name = NULL, + verbose = TRUE) { setGiottoImage( gobject = gobject, image = image, @@ -6021,11 +5980,12 @@ set_giottoImage <- function(gobject = NULL, #' setGiottoImage(g, NULL, name = objName(gimg)) #' setGiottoImage(gobject = g, image = gimg) #' @export -setGiottoImage <- function(gobject, - image, - image_type = NULL, - name = NULL, - verbose = NULL) { +setGiottoImage <- function( + gobject, + image, + image_type = NULL, + name = NULL, + verbose = NULL) { if (!inherits(gobject, "giotto")) { wrap_msg("Unable to set Giotto Image to non-Giotto object.") stop(wrap_txt("Please provide a Giotto object to the gobject argument.", @@ -6080,7 +6040,6 @@ setGiottoImage <- function(gobject, #' @name spatValues #' @title Giotto object spatial values #' @description -#' `r GiottoUtils::lifecycle_badge("experimental")`\cr #' Retrieve specific values from the `giotto` object for a specific `spat_unit` #' and `feat_type`. Values are returned as a data.table with the features #' requested and a `cell_ID` column. This function may be updated in the future @@ -6093,9 +6052,15 @@ setGiottoImage <- function(gobject, #' the giotto object #' @param expression_values character. (optional) Name of expression information #' to use +#' @param spat_loc_name character. (optional) Name of spatial locations +#' information to use #' @param spat_enr_name character. (optional) Name of spatial enrichments to #' use #' @param poly_info character. (optional) Name of polygons to use +#' @param dim_reduction_to_use character. (optional) Which type of dimension +#' reduction to use +#' @param dim_reduction_name character. (optional) Name of dimension reduction +#' to use #' @param verbose verbosity #' @param debug logical. (default = FALSE) See details. #' @returns A data.table with a cell_ID column and whichever feats were @@ -6105,13 +6070,15 @@ setGiottoImage <- function(gobject, #' spatValues searches through the set of available information within the #' `giotto` object for matches to `feats`. The current search order is #' \enumerate{ -#' \item cell expression +#' \item{cell expression} #' \item{cell metadata} +#' \item{spatial locations} #' \item{spatial enrichment} +#' \item{dimension reduction} #' \item{polygon info} #' } #' If a specific name for one of the types of information is provided via a -#' param such as `expression_values`, `spat_enr_name`, `poly_info`, then +#' param such as `expression_values`, `spat_enr_name`, etc, then #' the search will only be performed on that type of data.\cr\cr #' **\[debug\]**\cr #' This function uses Giotto's accessor functions which can usually throw errors @@ -6140,12 +6107,23 @@ setGiottoImage <- function(gobject, #' spatValues(g, spat_unit = "aggregate", feats = c("nr_feats")) #' #' @export -spatValues <- function(gobject, spat_unit = NULL, feat_type = NULL, feats, - expression_values = NULL, spat_enr_name = NULL, poly_info = NULL, - verbose = NULL, debug = FALSE) { +spatValues <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + feats, + expression_values = NULL, + spat_loc_name = NULL, + spat_enr_name = NULL, + poly_info = NULL, + dim_reduction_to_use = NULL, + dim_reduction_name = NULL, + verbose = NULL, + debug = FALSE) { checkmate::assert_class(gobject, "giotto") checkmate::assert_character(feats) + a <- get_args_list() # defaults spat_unit <- set_default_spat_unit( @@ -6158,6 +6136,18 @@ spatValues <- function(gobject, spat_unit = NULL, feat_type = NULL, feats, feat_type = feat_type ) + # multi spat_unit access + if (length(spat_unit) > 1) { + dt_list <- lapply(spat_unit, function(spat) { + a$spat_unit <- spat + res <- do.call(spatValues, args = a) + res[, spat_unit := spat] + }) + combtable <- Reduce(rbind, dt_list) + data.table::setcolorder(combtable, c("cell_ID", "spat_unit")) + return(combtable) + } + # checker closures ------------------------------------------------- # check_expr <- function(vals) { # %%%%%%%%%%%%%%%%%%%%% EXPR %%%%%% @@ -6220,6 +6210,34 @@ spatValues <- function(gobject, spat_unit = NULL, feat_type = NULL, feats, } return(NULL) } + check_spatloc <- function(vals) { # %%%%%%%%%%%%%% SPAT LOC %%%%%% + if (!is.null(vals)) { + return(vals) + } + sl <- getSpatialLocations( + gobject = gobject, + spat_unit = spat_unit, + name = spat_loc_name, + output = "spatLocsObj", + copy_obj = FALSE, + set_defaults = TRUE # try to guess name + ) + if (is.null(sl)) { + return(NULL) + } + if (all(feats %in% colnames(sl[]))) { + vals <- sl[][, unique(c("cell_ID", feats)), with = FALSE] + vmsg( + .v = verbose, + sprintf( + "Getting values from [%s][%s] spatial locations", + spatUnit(sl), objName(sl) + ) + ) + return(vals) + } + return(NULL) + } check_spatenr <- function(vals) { # %%%%%%%%%%%%%% SPAT ENR %%%%%% if (!is.null(vals)) { return(vals) @@ -6249,6 +6267,40 @@ spatValues <- function(gobject, spat_unit = NULL, feat_type = NULL, feats, } return(NULL) } + check_dimred <- function(vals) { # %%%%%%%%%%%%%% DIM RED %%%%%% + if (!is.null(vals)) { + return(vals) + } + dr <- getDimReduction( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + reduction = "cells", + name = dim_reduction_name, + reduction_method = dim_reduction_to_use, + output = "dimObj", + set_defaults = TRUE # try to guess reduc. method and name + ) + if (is.null(dr)) { + return(NULL) + } + if (all(feats %in% colnames(dr[]))) { + vals <- dr[][, feats, drop = FALSE] |> + as.matrix() |> + data.table::as.data.table(keep.rownames = TRUE) + data.table::setnames(vals, old = "rn", new = "cell_ID") + vmsg( + .v = verbose, + sprintf( + "Getting values from [%s][%s][%s][%s] dim reduction", + spatUnit(dr), featType(dr), + dr@reduction_method, objName(dr) + ) + ) + return(vals) + } + return(NULL) + } check_polyinfo <- function(vals) { # %%%%%%%%%%%% POLY INFO %%%%%% if (!is.null(vals)) { return(vals) @@ -6289,15 +6341,21 @@ spatValues <- function(gobject, spat_unit = NULL, feat_type = NULL, feats, # set nextcheck if location is known -------------------------------- # nextcheck <- NULL if (!is.null(spat_enr_name)) nextcheck <- "spatial enrichment" + if (!is.null(spat_loc_name)) nextcheck <- "spatial locations" if (!is.null(expression_values)) nextcheck <- "cell expression" if (!is.null(poly_info)) nextcheck <- "polygon info" + if (!is.null(dim_reduction_name) || !is.null(dim_reduction_to_use)) { + nextcheck <- "dimension reduction" + } # set order of checks if location not known ------------------------- # if (is.null(nextcheck)) { nextcheck <- c( "cell expression", "cell metadata", + "spatial locations", "spatial enrichment", + "dimension reduction", "polygon info" ) } @@ -6339,7 +6397,9 @@ spatValues <- function(gobject, spat_unit = NULL, feat_type = NULL, feats, "cell expression" = err_handler(check_expr(vals), data), "cell metadata" = err_handler(check_cellmeta(vals), data), "spatial enrichment" = err_handler(check_spatenr(vals), data), - "polygon info" = err_handler(check_polyinfo(vals), data) + "polygon info" = err_handler(check_polyinfo(vals), data), + "spatial locations" = err_handler(check_spatloc(vals), data), + "dimension reduction" = err_handler(check_dimred(vals), data) ) } @@ -6367,5 +6427,3 @@ spatValues <- function(gobject, spat_unit = NULL, feat_type = NULL, feats, } return(x) } - - diff --git a/R/slot_check.R b/R/slot_check.R index 7bd01032..eaef38dc 100644 --- a/R/slot_check.R +++ b/R/slot_check.R @@ -2,8 +2,9 @@ #' @keywords internal #' @noRd -.check_cell_metadata <- function(gobject, - verbose = TRUE) { +.check_cell_metadata <- function( + gobject, + verbose = TRUE) { # data.table vars cell_ID <- spat_unit <- NULL @@ -133,8 +134,9 @@ #' @keywords internal #' @noRd -.check_feat_metadata <- function(gobject, - verbose = TRUE) { +.check_feat_metadata <- function( + gobject, + verbose = TRUE) { # data.table vars feat_ID <- spat_unit <- feat_type <- NULL diff --git a/R/slot_list.R b/R/slot_list.R index 3f219541..14ff1ed1 100644 --- a/R/slot_list.R +++ b/R/slot_list.R @@ -14,9 +14,10 @@ #' #' list_giotto_data(gobject = g, slot = "expression") #' @export -list_giotto_data <- function(gobject = NULL, - slot = NULL, - ...) { +list_giotto_data <- function( + gobject = NULL, + slot = NULL, + ...) { if (slot == "expression") { return(list_expression(gobject = gobject, ...)) } @@ -67,9 +68,10 @@ list_giotto_data <- function(gobject = NULL, #' #' list_expression(g) #' @export -list_expression <- function(gobject, - spat_unit = NULL, - feat_type = NULL) { +list_expression <- function( + gobject, + spat_unit = NULL, + feat_type = NULL) { availableExpr <- data.table() for (spatial_unit in names(gobject@expression)) { for (feature_type in names(gobject@expression[[spatial_unit]])) { @@ -124,9 +126,10 @@ list_expression <- function(gobject, #' #' list_expression_names(g, spat_unit = "cell", feat_type = "rna") #' @export -list_expression_names <- function(gobject, - spat_unit = NULL, - feat_type = NULL) { +list_expression_names <- function( + gobject, + spat_unit = NULL, + feat_type = NULL) { if (is.null(spat_unit)) stop("spat_unit must be given\n") if (is.null(feat_type)) stop("feat_type must be given\n") @@ -179,10 +182,11 @@ list_feat_id_names <- function(gobject) { #' #' list_cell_metadata(g) #' @export -list_cell_metadata <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - return_uniques = FALSE) { +list_cell_metadata <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + return_uniques = FALSE) { availableCMet <- data.table() uniques <- list() for (spatial_unit in names(gobject@cell_metadata)) { @@ -239,10 +243,11 @@ list_cell_metadata <- function(gobject, #' #' list_feat_metadata(g) #' @export -list_feat_metadata <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - return_uniques = FALSE) { +list_feat_metadata <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + return_uniques = FALSE) { availableFMet <- data.table() uniques <- list() for (spatial_unit in names(gobject@feat_metadata)) { @@ -299,9 +304,10 @@ list_feat_metadata <- function(gobject, #' #' list_spatial_locations(g) #' @export -list_spatial_locations <- function(gobject, - spat_unit = NULL, - return_uniques = FALSE) { +list_spatial_locations <- function( + gobject, + spat_unit = NULL, + return_uniques = FALSE) { availableSpatLocs <- data.table() uniques <- list() for (spatial_unit in names(gobject@spatial_locs)) { @@ -358,8 +364,9 @@ list_spatial_locations <- function(gobject, #' #' list_spatial_locations_names(g, spat_unit = "cell") #' @export -list_spatial_locations_names <- function(gobject, - spat_unit = NULL) { +list_spatial_locations_names <- function( + gobject, + spat_unit = NULL) { if (is.null(spat_unit)) stop("spat_unit must be given\n") spatlocs_names <- names(gobject@spatial_locs[[spat_unit]]) @@ -379,9 +386,10 @@ list_spatial_locations_names <- function(gobject, #' #' list_spatial_enrichments(g) #' @export -list_spatial_enrichments <- function(gobject, - spat_unit = NULL, - feat_type = NULL) { +list_spatial_enrichments <- function( + gobject, + spat_unit = NULL, + feat_type = NULL) { availableSpatEnr <- data.table() for (spatial_unit in names(gobject@spatial_enrichment)) { @@ -441,9 +449,10 @@ list_spatial_enrichments <- function(gobject, #' #' list_spatial_enrichments_names(g, spat_unit = "aggregate", feat_type = "rna") #' @export -list_spatial_enrichments_names <- function(gobject, - spat_unit = NULL, - feat_type = NULL) { +list_spatial_enrichments_names <- function( + gobject, + spat_unit = NULL, + feat_type = NULL) { if (is.null(spat_unit)) stop("spat_unit must be given\n") if (is.null(feat_type)) stop("feat_type must be given\n") @@ -468,11 +477,12 @@ list_spatial_enrichments_names <- function(gobject, #' #' list_dim_reductions(g) #' @export -list_dim_reductions <- function(gobject, - data_type = NULL, - spat_unit = NULL, - feat_type = NULL, - dim_type = NULL) { +list_dim_reductions <- function( + gobject, + data_type = NULL, + spat_unit = NULL, + feat_type = NULL, + dim_type = NULL) { availableDimRed <- data.table() for (dataType in names(slot(gobject, "dimension_reduction"))) { for (spatUnit in @@ -555,11 +565,12 @@ list_dim_reductions <- function(gobject, #' dim_type = "pca" #' ) #' @export -list_dim_reductions_names <- function(gobject, - data_type = "cells", - spat_unit = NULL, - feat_type = NULL, - dim_type = NULL) { +list_dim_reductions_names <- function( + gobject, + data_type = "cells", + spat_unit = NULL, + feat_type = NULL, + dim_type = NULL) { if (is.null(spat_unit)) stop("spat_unit must be given\n") if (is.null(feat_type)) stop("feat_type must be given\n") if (is.null(dim_type)) stop("dim_type must be given\n") @@ -582,11 +593,12 @@ list_dim_reductions_names <- function(gobject, #' #' list_nearest_networks(g) #' @export -list_nearest_networks <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - nn_type = NULL, - return_uniques = FALSE) { +list_nearest_networks <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + nn_type = NULL, + return_uniques = FALSE) { # TODO remove uniques availableNN <- data.table() @@ -670,10 +682,11 @@ list_nearest_networks <- function(gobject, #' nn_type = "sNN" #' ) #' @export -list_nearest_networks_names <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - nn_type = NULL) { +list_nearest_networks_names <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + nn_type = NULL) { if (is.null(spat_unit)) stop("spat_unit must be given\n") if (is.null(feat_type)) stop("feat_type must be given\n") if (is.null(nn_type)) stop("nn_type must be given\n") @@ -792,9 +805,10 @@ list_feature_info_names <- function(gobject) { #' #' list_spatial_networks(g) #' @export -list_spatial_networks <- function(gobject, - spat_unit = NULL, - return_uniques = FALSE) { +list_spatial_networks <- function( + gobject, + spat_unit = NULL, + return_uniques = FALSE) { availableSpatNetworks <- data.table() uniques <- list() for (spatial_unit in names(gobject@spatial_network)) { @@ -848,8 +862,9 @@ list_spatial_networks <- function(gobject, #' #' list_spatial_networks_names(g, spat_unit = "cell") #' @export -list_spatial_networks_names <- function(gobject, - spat_unit = NULL) { +list_spatial_networks_names <- function( + gobject, + spat_unit = NULL) { if (is.null(spat_unit)) stop("spat_unit must be given\n") spat_network_names <- names(gobject@spatial_network[[spat_unit]]) @@ -873,10 +888,11 @@ list_spatial_networks_names <- function(gobject, #' #' list_spatial_grids(g) #' @export -list_spatial_grids <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - return_uniques = FALSE) { +list_spatial_grids <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + return_uniques = FALSE) { availableSpatGrids <- data.table() uniques <- list() for (spatial_unit in names(gobject@spatial_grid)) { @@ -948,10 +964,11 @@ list_spatial_grids <- function(gobject, #' #' list_spatial_grids_names(g, spat_unit = "cell", feat_type = "rna") #' @export -list_spatial_grids_names <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - return_uniques = FALSE) { +list_spatial_grids_names <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + return_uniques = FALSE) { if (is.null(spat_unit)) stop("spat_unit must be given\n") if (is.null(feat_type)) stop("feat_type must be given\n") @@ -973,25 +990,24 @@ list_spatial_grids_names <- function(gobject, #' list_images(g) #' list_images(g, img_type = "largeImage") #' @export -list_images <- function(gobject, - img_type = NULL) { +list_images <- function( + gobject, + img_type = NULL) { img_info <- lapply( slot(gobject, "images"), function(img) { data.table::data.table( name = objName(img), - img_type = class(img) + img_type = if (inherits(img, "giottoLargeImage")) { + "largeImage" + } else if (inherits(img, "giottoImage")) { + "image" + } ) } ) avail_imgs <- data.table::rbindlist(img_info) - # change to shortnames for img_type - if (nrow(avail_imgs) > 0) { - avail_imgs[img_type == "giottoLargeImage", img_type := "largeImage"] - avail_imgs[img_type == "giottoImage", img_type := "image"] - } - # check if a specific category is desired if (!is.null(img_type)) { img_type_subset <- avail_imgs$img_type %in% img_type @@ -1024,8 +1040,9 @@ list_images <- function(gobject, #' list_images_names(g) #' list_images_names(g, img_type = "largeImage") #' @export -list_images_names <- function(gobject, - img_type = NULL) { +list_images_names <- function( + gobject, + img_type = NULL) { if (!is.null(img_type)) { img_type <- match.arg(img_type, choices = c("image", "largeImage")) } diff --git a/R/slot_show.R b/R/slot_show.R index 3f223a36..011d89c2 100644 --- a/R/slot_show.R +++ b/R/slot_show.R @@ -122,8 +122,9 @@ showGiottoExpression <- function(gobject, nrows = 4, ncols = 4) { #' #' showGiottoCellMetadata(g) #' @export -showGiottoCellMetadata <- function(gobject, - nrows = 4) { +showGiottoCellMetadata <- function( + gobject, + nrows = 4) { # import print styling ch <- box_chars() ct <- color_tag() @@ -211,8 +212,9 @@ showGiottoCellMetadata <- function(gobject, #' #' showGiottoFeatMetadata(g) #' @export -showGiottoFeatMetadata <- function(gobject, - nrows = 4) { +showGiottoFeatMetadata <- function( + gobject, + nrows = 4) { # import print styling ch <- box_chars() ct <- color_tag() @@ -301,8 +303,9 @@ showGiottoFeatMetadata <- function(gobject, #' #' showGiottoSpatLocs(g) #' @export -showGiottoSpatLocs <- function(gobject, - nrows = 4) { +showGiottoSpatLocs <- function( + gobject, + nrows = 4) { # import print styling ch <- box_chars() ct <- color_tag() @@ -422,8 +425,9 @@ showGiottoSpatLocs <- function(gobject, #' #' showGiottoSpatEnrichments(g) #' @export -showGiottoSpatEnrichments <- function(gobject, - nrows = 4) { +showGiottoSpatEnrichments <- function( + gobject, + nrows = 4) { # NSE vars spat_unit <- feat_type <- name <- NULL @@ -475,9 +479,10 @@ showGiottoSpatEnrichments <- function(gobject, #' #' showGiottoDimRed(g) #' @export -showGiottoDimRed <- function(gobject, - nrows = 3, - ncols = 2) { +showGiottoDimRed <- function( + gobject, + nrows = 3, + ncols = 2) { # Define for data.table data_type <- NULL @@ -630,8 +635,9 @@ showGiottoDimRed <- function(gobject, #' #' showGiottoNearestNetworks(g) #' @export -showGiottoNearestNetworks <- function(gobject, - nrows = 3) { +showGiottoNearestNetworks <- function( + gobject, + nrows = 3) { # import print styling ch <- box_chars() ct <- color_tag() @@ -808,8 +814,9 @@ showGiottoFeatInfo <- function(gobject) { #' #' showGiottoSpatNetworks(g) #' @export -showGiottoSpatNetworks <- function(gobject, - nrows = 4) { +showGiottoSpatNetworks <- function( + gobject, + nrows = 4) { # import print styling ch <- box_chars() ct <- color_tag() @@ -916,8 +923,9 @@ showNetworks <- function(...) { #' #' showGiottoSpatGrids(g) #' @export -showGiottoSpatGrids <- function(gobject, - nrows = 4) { +showGiottoSpatGrids <- function( + gobject, + nrows = 4) { # import boxchars ch <- box_chars() @@ -1059,10 +1067,11 @@ showGiottoImageNames <- function(gobject) { #' @details Much inspiration taken from https://rdrr.io/cran/fs/src/R/tree.R #' @returns Hierarchical tree #' @keywords internal -.print_leaf <- function(level_index, - availableDT, - inherit_last = TRUE, - indent) { +.print_leaf <- function( + level_index, + availableDT, + inherit_last = TRUE, + indent) { ch <- box_chars() leafs <- unique(unlist(availableDT[, level_index, with = FALSE])) diff --git a/R/spatial_binary_ops.R b/R/spatial_binary_ops.R new file mode 100644 index 00000000..ae8866dd --- /dev/null +++ b/R/spatial_binary_ops.R @@ -0,0 +1,114 @@ +# docs ----------------------------------------------------------- # +#' @title Spatial binary operations +#' @name spatial_binary_ops +#' @aliases snap erase symdif union intersect +#' @description Perform geometric binary operations on Giotto spatial classes +#' (`giottoPolygon`, `giottoPoints` and `spatLocsObj`) and underlying +#' representations (only terra `SpatVector` right now.) +#' @param x spatial object 1 +#' @param y spatial object 2 (can be missing or NULL) +#' @param ... additional args to pass +#' @returns The same class as `x` +#' @usage +#' # S4 methods for giottoPolygon, giottoPoints, spatLocsObj, SpatVector # +#' @examples +#' gpoly1 <- GiottoData::loadSubObjectMini("giottoPolygon") +#' epoly <- as.polygons(ext(c(6600, 6800, -5000, -4800))) +#' gpoly2 <- spatShift(gpoly1, dx = 20) +#' +#' plot(gpoly1) +#' plot(union(gpoly1, gpoly2)) +#' plot(erase(gpoly1, epoly)) +#' +#' plot(union(gpoly1, epoly)) +#' +#' plot(symdif(gpoly1, epoly)) +#' +#' plot(intersect(gpoly1, epoly)) +#' +#' if (FALSE) { +#' # takes a long time so don't run in checks +#' plot(snap(gpoly1, tolerance = 0.2)) +#' } +NULL +# ---------------------------------------------------------------- # + + +# erase #### +#' @rdname spatial_binary_ops +#' @export +setMethod("erase", signature(x = "spatialClasses", y = "spatialClasses"), function(x, y, ...) { + x0 <- x + if (inherits(x, "spatLocsObj")) x <- as.points(x) + if (inherits(y, "spatLocsObj")) y <- as.points(y) + if (inherits(x, "giottoSpatial")) x <- x[] + if (inherits(y, "giottoSpatial")) y <- y[] + res <- erase(x, y, ...) + x0[] <- res + x0@unique_ID_cache <- spatIDs(x0, use_cache = FALSE, uniques = TRUE) + return(x0) +}) + +# snap #### +#' @rdname spatial_binary_ops +#' @inheritParams terra::snap +#' @export +setMethod("snap", signature("giottoSpatial"), function(x, y = NULL, tolerance, ...) { + if (inherits(x, "spatLocsObj")) x_use <- as.points(x) + if (inherits(x, "giottoSpatial")) x_use <- x[] + if (!is.null(y)) { + if (inherits(y, "spatLocsObj")) y <- as.points(y) + if (inherits(y, "giottoSpatial")) y <- y[] + } + res <- snap(x_use, y, tolerance, ...) + x[] <- res + return(res) +}) + + +# symdif #### +#' @rdname spatial_binary_ops +#' @export +setMethod("symdif", signature(x = "spatialClasses", y = "spatialClasses"), function(x, y, ...) { + x0 <- x + if (inherits(x, "spatLocsObj")) x <- as.points(x) + if (inherits(y, "spatLocsObj")) y <- as.points(y) + if (inherits(x, "giottoSpatial")) x <- x[] + if (inherits(y, "giottoSpatial")) y <- y[] + res <- symdif(x, y, ...) + x0[] <- res + x0@unique_ID_cache <- spatIDs(x0, use_cache = FALSE, uniques = TRUE) + return(x0) +}) + +# union #### +#' @rdname spatial_binary_ops +#' @export +setMethod("union", signature(x = "spatialClasses", y = "spatialClasses"), function(x, y) { + x0 <- x + if (inherits(x, "spatLocsObj")) x <- as.points(x) + if (inherits(y, "spatLocsObj")) y <- as.points(y) + if (inherits(x, "giottoSpatial")) x <- x[] + if (inherits(y, "giottoSpatial")) y <- y[] + res <- terra::union(x, y) + x0[] <- res + x0@unique_ID_cache <- spatIDs(x0, use_cache = FALSE, uniques = TRUE) + return(x0) +}) + + +# intersect #### + +#' @rdname spatial_binary_ops +#' @export +setMethod("intersect", signature(x = "spatialClasses", y = "spatialClasses"), function(x, y) { + x0 <- x + if (inherits(x, "spatLocsObj")) x <- as.points(x) + if (inherits(y, "spatLocsObj")) y <- as.points(y) + if (inherits(x, "giottoSpatial")) x <- x[] + if (inherits(y, "giottoSpatial")) y <- y[] + res <- terra::intersect(x, y) + x0[] <- res + x0@unique_ID_cache <- spatIDs(x0, use_cache = FALSE, uniques = TRUE) + return(x0) +}) diff --git a/R/spatial_query.R b/R/spatial_query.R index 0f2560c9..fd6e8fa5 100644 --- a/R/spatial_query.R +++ b/R/spatial_query.R @@ -21,13 +21,14 @@ #' 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 [spatQueryGiottoSpatLocs() +#' @seealso [relate()] #' @export -spatQueryGiottoPolygons <- function(gobject, - filters, - name = "query_polys", - feat_type = NULL, - clip = TRUE) { +spatQueryGiottoPolygons <- function( + gobject, + filters, + name = "query_polys", + feat_type = NULL, + clip = TRUE) { assert_giotto(gobject) if (!is.null(name)) checkmate::assert_character(name) checkmate::assert_list(filters, types = "character") diff --git a/R/spatial_structures.R b/R/spatial_structures.R index 2bb5ec3f..5690c260 100644 --- a/R/spatial_structures.R +++ b/R/spatial_structures.R @@ -181,11 +181,12 @@ convert_to_reduced_spatial_network <- function(full_spatial_network_DT) { #' network #' @keywords internal #' @returns data.table -.calculate_distance_and_weight <- function(networkDT = NULL, - sdimx = "sdimx", - sdimy = "sdimy", - sdimz = "sdimz", - d2_or_d3 = c(2, 3)) { +.calculate_distance_and_weight <- function( + networkDT = NULL, + sdimx = "sdimx", + sdimy = "sdimy", + sdimz = "sdimz", + d2_or_d3 = c(2, 3)) { # data.table variables distance <- weight <- from <- NULL @@ -253,8 +254,9 @@ convert_to_reduced_spatial_network <- function(full_spatial_network_DT) { #' #' get_distance(spat_net, method = "mean") #' @export -get_distance <- function(networkDT, - method = c("mean", "median")) { +get_distance <- function( + networkDT, + method = c("mean", "median")) { distance <- switch(method, "median" = stats::median(networkDT$distance), "mean" = mean(networkDT$distance) @@ -274,9 +276,10 @@ get_distance <- function(networkDT, #' @param minimum_k minimum number of neighbors #' @keywords internal #' @returns data.table -.filter_network <- function(networkDT = NULL, - maximum_distance = NULL, - minimum_k = NULL) { +.filter_network <- function( + networkDT = NULL, + maximum_distance = NULL, + minimum_k = NULL) { # data.table variables distance <- rank_int <- NULL @@ -317,8 +320,9 @@ get_distance <- function(networkDT, #' #' compatible_spatial_network(spat_net, expr_m) #' @export -compatible_spatial_network <- function(spatial_network, - expression_matrix) { +compatible_spatial_network <- function( + spatial_network, + expression_matrix) { # first evaluate spatial network spatial_network <- .evaluate_spatial_network(spatial_network) @@ -393,11 +397,12 @@ spat_net_to_igraph <- function(spatialNetworkObj, attr = NULL) { #' @description Create a spatial Delaunay network. #' @keywords internal #' @returns spatial Delaunay network -.create_delaunaynetwork_geometry <- function(spatial_locations, - sdimx = "sdimx", - sdimy = "sdimy", - options = "Pp", - ...) { +.create_delaunaynetwork_geometry <- function( + spatial_locations, + sdimx = "sdimx", + sdimy = "sdimy", + options = "Pp", + ...) { # verify if optional package is installed package_check(pkg_name = "geometry", repository = "CRAN") @@ -464,12 +469,13 @@ spat_net_to_igraph <- function(spatialNetworkObj, attr = NULL) { #' @description Create a spatial 3D Delaunay network with geometry #' @keywords internal #' @returns spatial 3D Delaunay network with geometry -.create_delaunaynetwork_geometry_3d <- function(spatial_locations, - sdimx = "sdimx", - sdimy = "sdimy", - sdimz = "sdimz", - options = options, - ...) { +.create_delaunaynetwork_geometry_3d <- function( + spatial_locations, + sdimx = "sdimx", + sdimy = "sdimy", + sdimz = "sdimz", + options = options, + ...) { # verify if optional package is installed package_check(pkg_name = "geometry", repository = "CRAN") @@ -548,13 +554,14 @@ spat_net_to_igraph <- function(spatialNetworkObj, attr = NULL) { #' @description Create a spatial Delaunay network with RTriangle #' @keywords internal #' @returns spatial Delaunay network with RTriangle -.create_delaunaynetwork_RTriangle <- function(spatial_locations, - sdimx = "sdimx", - sdimy = "sdimy", - Y = TRUE, - j = TRUE, - S = 0, - ...) { +.create_delaunaynetwork_RTriangle <- function( + spatial_locations, + sdimx = "sdimx", + sdimy = "sdimy", + Y = TRUE, + j = TRUE, + S = 0, + ...) { # verify if optional package is installed package_check(pkg_name = "RTriangle", repository = "CRAN") @@ -609,10 +616,11 @@ spat_net_to_igraph <- function(spatialNetworkObj, attr = NULL) { #' @description Create a spatial Delaunay network with deldir #' @keywords internal #' @returns spatial Delaunay network with deldir -.create_delaunaynetwork_deldir <- function(spatial_locations, - sdimx = "sdimx", - sdimy = "sdimy", - ...) { +.create_delaunaynetwork_deldir <- function( + spatial_locations, + sdimx = "sdimx", + sdimy = "sdimy", + ...) { # data.table variables from <- to <- NULL @@ -667,23 +675,24 @@ spat_net_to_igraph <- function(spatialNetworkObj, attr = NULL) { #' @description Create a spatial 2D Delaunay network. #' @keywords internal #' @returns spatial 2D Delaunay network -.create_delaunaynetwork_2d <- function(gobject, - method = c("delaunayn_geometry", "RTriangle", "deldir"), - spat_unit = NULL, - spat_loc_name = "raw", - sdimx = "sdimx", - sdimy = "sdimy", - name = "delaunay_network", - maximum_distance = "auto", # all - minimum_k = 0, # all - options = "Pp", # geometry - Y = TRUE, # RTriange - j = TRUE, # RTriange - S = 0, # RTriange - verbose = TRUE, - return_gobject = TRUE, - output = c("spatialNetworkObj", "data.table"), - ...) { +.create_delaunaynetwork_2d <- function( + gobject, + method = c("delaunayn_geometry", "RTriangle", "deldir"), + spat_unit = NULL, + spat_loc_name = "raw", + sdimx = "sdimx", + sdimy = "sdimy", + name = "delaunay_network", + maximum_distance = "auto", # all + minimum_k = 0, # all + options = "Pp", # geometry + Y = TRUE, # RTriange + j = TRUE, # RTriange + S = 0, # RTriange + verbose = TRUE, + return_gobject = TRUE, + output = c("spatialNetworkObj", "data.table"), + ...) { # get parameter values method <- match.arg(method, c("delaunayn_geometry", "RTriangle", "deldir")) output <- match.arg(output, c("spatialNetworkObj", "data.table")) @@ -888,20 +897,21 @@ spat_net_to_igraph <- function(spatialNetworkObj, attr = NULL) { #' @description Create a spatial 3D Delaunay network. #' @keywords internal #' @returns spatial 3D Delaunay network -.create_delaunaynetwork_3d <- function(gobject, - method = "delaunayn_geometry", - spat_unit = NULL, - spat_loc_name = "raw", - sdimx = "sdimx", - sdimy = "sdimy", - sdimz = "sdimz", - name = "delaunay_network_3D", - maximum_distance = "auto", - minimum_k = 0, # all - options = "Pp", # geometry - return_gobject = TRUE, - output = c("spatialNetworkObj", "data.table"), - ...) { +.create_delaunaynetwork_3d <- function( + gobject, + method = "delaunayn_geometry", + spat_unit = NULL, + spat_loc_name = "raw", + sdimx = "sdimx", + sdimy = "sdimy", + sdimz = "sdimz", + name = "delaunay_network_3D", + maximum_distance = "auto", + minimum_k = 0, # all + options = "Pp", # geometry + return_gobject = TRUE, + output = c("spatialNetworkObj", "data.table"), + ...) { # get parameter values method <- match.arg(method, c("delaunayn_geometry", "RTriangle", "deldir")) output <- match.arg(output, c("spatialNetworkObj", "data.table")) @@ -1075,23 +1085,24 @@ spat_net_to_igraph <- function(spatialNetworkObj, attr = NULL) { #' #' createSpatialDelaunayNetwork(g) #' @export -createSpatialDelaunayNetwork <- function(gobject, - name = "Delaunay_network", - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = NULL, - method = c("deldir", "delaunayn_geometry", "RTriangle"), - dimensions = "all", - maximum_distance = "auto", # all - minimum_k = 0, # all - options = "Pp", # geometry - Y = TRUE, # RTriangle - j = TRUE, # RTriangle - S = 0, # RTriangle - verbose = TRUE, - return_gobject = TRUE, - output = c("spatialNetworkObj", "data.table"), - ...) { +createSpatialDelaunayNetwork <- function( + gobject, + name = "Delaunay_network", + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = NULL, + method = c("deldir", "delaunayn_geometry", "RTriangle"), + dimensions = "all", + maximum_distance = "auto", # all + minimum_k = 0, # all + options = "Pp", # geometry + Y = TRUE, # RTriangle + j = TRUE, # RTriangle + S = 0, # RTriangle + verbose = TRUE, + return_gobject = TRUE, + output = c("spatialNetworkObj", "data.table"), + ...) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1197,12 +1208,13 @@ createSpatialDelaunayNetwork <- function(gobject, #' @description Create a spatial knn network with dbscan #' @keywords internal #' @returns spatial knn network with dbscan -create_KNNnetwork_dbscan <- function(spatial_locations, - sdimx = "sdimx", - sdimy = "sdimy", - sdimz = "sdimz", - k = 4, - ...) { +create_KNNnetwork_dbscan <- function( + spatial_locations, + sdimx = "sdimx", + sdimy = "sdimy", + sdimz = "sdimz", + k = 4, + ...) { # data.table variables from <- to <- NULL @@ -1360,20 +1372,21 @@ create_KNNnetwork_dbscan <- function(spatial_locations, #' createSpatialKNNnetwork(g) #' #' @export -createSpatialKNNnetwork <- function(gobject, - method = "dbscan", - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = NULL, - dimensions = "all", - name = "knn_network", - k = 4, - maximum_distance = NULL, - minimum_k = 0, - verbose = FALSE, - return_gobject = TRUE, - output = c("spatialNetworkObj", "data.table"), - ...) { +createSpatialKNNnetwork <- function( + gobject, + method = "dbscan", + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = NULL, + dimensions = "all", + name = "knn_network", + k = 4, + maximum_distance = NULL, + minimum_k = 0, + verbose = FALSE, + return_gobject = TRUE, + output = c("spatialNetworkObj", "data.table"), + ...) { output <- match.arg(output, c("spatialNetworkObj", "data.table")) # Set feat_type and spat_unit @@ -1596,27 +1609,28 @@ createSpatialKNNnetwork <- function(gobject, #' #' createSpatialNetwork(g) #' @export -createSpatialNetwork <- function(gobject, - name = NULL, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = NULL, - dimensions = "all", - method = c("Delaunay", "kNN"), - delaunay_method = c("deldir", "delaunayn_geometry", "RTriangle"), - maximum_distance_delaunay = "auto", - options = "Pp", - Y = TRUE, - j = TRUE, - S = 0, - minimum_k = 0, - knn_method = "dbscan", - k = 4, - maximum_distance_knn = NULL, - verbose = FALSE, - return_gobject = TRUE, - output = c("spatialNetworkObj", "data.table"), - ...) { +createSpatialNetwork <- function( + gobject, + name = NULL, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = NULL, + dimensions = "all", + method = c("Delaunay", "kNN"), + delaunay_method = c("deldir", "delaunayn_geometry", "RTriangle"), + maximum_distance_delaunay = "auto", + options = "Pp", + Y = TRUE, + j = TRUE, + S = 0, + minimum_k = 0, + knn_method = "dbscan", + k = 4, + maximum_distance_knn = NULL, + verbose = FALSE, + return_gobject = TRUE, + output = c("spatialNetworkObj", "data.table"), + ...) { # get paramters method <- match.arg(method, c("Delaunay", "kNN")) @@ -1696,12 +1710,13 @@ createSpatialNetwork <- function(gobject, #' #' annotateSpatialNetwork(g, cluster_column = "leiden_clus") #' @export -annotateSpatialNetwork <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spatial_network_name = "Delaunay_network", - cluster_column, - create_full_network = FALSE) { +annotateSpatialNetwork <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + spatial_network_name = "Delaunay_network", + cluster_column, + create_full_network = FALSE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1836,13 +1851,14 @@ annotateSpatialNetwork <- function(gobject, #' #' createSpatialWeightMatrix(g, spatial_network_to_use = "spatial_network") #' @export -createSpatialWeightMatrix <- function(gobject, - spat_unit = NULL, - spatial_network_to_use = "kNN_network", - method = c("distance", "adjacency"), - wm_name = "spat_weights", - return_gobject = TRUE, - verbose = TRUE) { +createSpatialWeightMatrix <- function( + gobject, + spat_unit = NULL, + spatial_network_to_use = "kNN_network", + method = c("distance", "adjacency"), + wm_name = "spat_weights", + return_gobject = TRUE, + verbose = TRUE) { # 1. setup spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1978,12 +1994,13 @@ createSpatialWeightMatrix <- function(gobject, #' @description create a 2D spatial grid #' @keywords internal #' @returns 2D spatial grid -.create_spatialgrid_default_2d <- function(gobject, - spat_unit = NULL, - spat_loc_name = "raw", - sdimx_stepsize = NULL, - sdimy_stepsize = NULL, - minimum_padding = 1) { +.create_spatialgrid_default_2d <- function( + gobject, + spat_unit = NULL, + spat_loc_name = "raw", + sdimx_stepsize = NULL, + sdimy_stepsize = NULL, + minimum_padding = 1) { # data.table variables gr_name <- gr_x_name <- gr_y_name <- gr_x_loc <- gr_y_loc <- gr_loc <- NULL @@ -2069,13 +2086,14 @@ createSpatialWeightMatrix <- function(gobject, #' @description create a 3D spatial grid #' @keywords internal #' @returns 3D spatial grid -.create_spatialgrid_default_3d <- function(gobject, - spat_unit = NULL, - spat_loc_name = "raw", - sdimx_stepsize = NULL, - sdimy_stepsize = NULL, - sdimz_stepsize = NULL, - minimum_padding = 1) { +.create_spatialgrid_default_3d <- function( + gobject, + spat_unit = NULL, + spat_loc_name = "raw", + sdimx_stepsize = NULL, + sdimy_stepsize = NULL, + sdimz_stepsize = NULL, + minimum_padding = 1) { # data.table variables gr_name <- gr_x_name <- gr_y_name <- gr_z_name <- gr_x_loc <- gr_y_loc <- gr_z_loc <- gr_loc <- NULL @@ -2199,16 +2217,17 @@ createSpatialWeightMatrix <- function(gobject, #' #' createSpatialDefaultGrid(g, sdimx_stepsize = 5, sdimy_stepsize = 5) #' @export -createSpatialDefaultGrid <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = "raw", - sdimx_stepsize = NULL, - sdimy_stepsize = NULL, - sdimz_stepsize = NULL, - minimum_padding = 1, - name = NULL, - return_gobject = TRUE) { +createSpatialDefaultGrid <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = "raw", + sdimx_stepsize = NULL, + sdimy_stepsize = NULL, + sdimz_stepsize = NULL, + minimum_padding = 1, + name = NULL, + return_gobject = TRUE) { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -2341,23 +2360,24 @@ createSpatialDefaultGrid <- function(gobject, #' @details Creates a spatial grid with defined x, y (and z) dimensions. #' The dimension units are based on the provided spatial location units. #' * **default method:** \code{\link{createSpatialDefaultGrid}} -#' +#' #' @examples #' g <- GiottoData::loadGiottoMini("visium") #' #' createSpatialGrid(g, sdimx_stepsize = 5, sdimy_stepsize = 5) #' #' @export -createSpatialGrid <- function(gobject, - spat_unit = NULL, - spat_loc_name = "raw", - name = NULL, - method = c("default"), - sdimx_stepsize = NULL, - sdimy_stepsize = NULL, - sdimz_stepsize = NULL, - minimum_padding = 1, - return_gobject = TRUE) { +createSpatialGrid <- function( + gobject, + spat_unit = NULL, + spat_loc_name = "raw", + name = NULL, + method = c("default"), + sdimx_stepsize = NULL, + sdimy_stepsize = NULL, + sdimz_stepsize = NULL, + minimum_padding = 1, + return_gobject = TRUE) { # get parameters method <- match.arg(method, c("default")) @@ -2400,8 +2420,9 @@ createSpatialGrid <- function(gobject, #' spatgrid = g_spatgrid #' ) #' @export -annotate_spatlocs_with_spatgrid_2D <- function(spatloc, - spatgrid) { +annotate_spatlocs_with_spatgrid_2D <- function( + spatloc, + spatgrid) { ## second label the spatial locations ## spatlocs <- data.table::copy(spatloc) @@ -2457,8 +2478,9 @@ annotate_spatlocs_with_spatgrid_2D <- function(spatloc, #' spatgrid = g_spatgrid #' ) #' @export -annotate_spatlocs_with_spatgrid_3D <- function(spatloc, - spatgrid) { +annotate_spatlocs_with_spatgrid_3D <- function( + spatloc, + spatgrid) { ## second label the spatial locations ## spatlocs <- data.table::copy(spatloc) @@ -2532,12 +2554,13 @@ annotate_spatlocs_with_spatgrid_3D <- function(spatloc, #' #' annotateSpatialGrid(g) #' @export -annotateSpatialGrid <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = "raw", - spatial_grid_name = "spatial_grid", - cluster_columns = NULL) { +annotateSpatialGrid <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = "raw", + spatial_grid_name = "spatial_grid", + cluster_columns = NULL) { # get grid spatial_grid <- get_spatialGrid( gobject = gobject, diff --git a/R/split.R b/R/split.R new file mode 100644 index 00000000..784bd3c8 --- /dev/null +++ b/R/split.R @@ -0,0 +1,34 @@ +#' @name splitGiotto +#' @title Split a Giotto Object +#' @description +#' Split a Giotto object based on a cell metadata column into a list of multiple +#' Giotto objects. +#' @param gobject giotto object to split +#' @param by cell metadata column by which to split the object +#' @param spat_unit character. Controls which spatial unit to pull splitting +#' information from. However, all spatial units will always be affected by the +#' split. +#' @param feat_type character. Split affects these feature type(s). Default is +#' "rna" +#' @export +#' @returns `list` of `giotto` objects +#' @examples +#' g <- GiottoData::loadGiottoMini("visium") +#' splitGiotto(g, "leiden_clus") +#' +splitGiotto <- function(gobject, by, spat_unit = NULL, feat_type = NULL) { + split_factor <- unique(spatValues(gobject, feats = by, verbose = FALSE)[[by]]) + + # define names for numeric factors + split_factor_names <- if (is.numeric(split_factor)) { + paste(by, split_factor, sep = "_") + } else { + split_factor_names <- split_factor + } + + names(split_factor) <- split_factor_names + lapply(split_factor, function(clus) { + split_call <- call("==", as.name(by), clus) + subset(gobject, subset = split_call, quote = FALSE) + }) +} diff --git a/R/stitch_coordinates.R b/R/stitch_coordinates.R index 1f8552d8..7ce11b2c 100644 --- a/R/stitch_coordinates.R +++ b/R/stitch_coordinates.R @@ -26,17 +26,18 @@ #' locations with stitchFieldCoordinates #' 4. provide new cell location file #' to \code{\link{createGiottoObject}} -#' +#' #' @export -stitchFieldCoordinates <- function(location_file, - offset_file, - cumulate_offset_x = FALSE, - cumulate_offset_y = FALSE, - field_col = "Field of View", - X_coord_col = "X", - Y_coord_col = "Y", - reverse_final_x = FALSE, - reverse_final_y = TRUE) { +stitchFieldCoordinates <- function( + location_file, + offset_file, + cumulate_offset_x = FALSE, + cumulate_offset_y = FALSE, + field_col = "Field of View", + X_coord_col = "X", + Y_coord_col = "Y", + reverse_final_x = FALSE, + reverse_final_y = TRUE) { # data.table variables x_offset_final <- x_offset <- y_offset_final <- y_offset <- field <- NULL @@ -104,9 +105,10 @@ stitchFieldCoordinates <- function(location_file, #' #' stitchTileCoordinates(location_file, Xtilespan = 0.5, Ytilespan = 0.5) #' @export -stitchTileCoordinates <- function(location_file, - Xtilespan, - Ytilespan) { +stitchTileCoordinates <- function( + location_file, + Xtilespan, + Ytilespan) { # data.table variables Xcoord <- X.X <- XtileIndex <- Ycoord <- Y.Y <- YtileIndex <- NULL diff --git a/R/subset.R b/R/subset.R index 9585434c..8115a401 100644 --- a/R/subset.R +++ b/R/subset.R @@ -84,14 +84,18 @@ if (isTRUE(avail_ex[ex_i]$subset_cells) && !isTRUE(avail_ex[ex_i]$subset_feats)) { filter_bool_cells <- spatIDs(ex) %in% cell_ids - ex[] <- .finalize_expr_subset(ex[][, filter_bool_cells]) + ex[] <- .finalize_expr_subset( + ex[][, filter_bool_cells, drop = FALSE] + ) } ## feat only subsets if (!isTRUE(avail_ex[ex_i]$subset_cells) && isTRUE(avail_ex[ex_i]$subset_feats)) { filter_bool_feats <- featIDs(ex) %in% feat_ids - ex[] <- .finalize_expr_subset(ex[][filter_bool_feats, ]) + ex[] <- .finalize_expr_subset( + ex[][filter_bool_feats, , drop = FALSE] + ) } ## cell and feat subsets @@ -101,7 +105,8 @@ filter_bool_feats <- featIDs(ex) %in% feat_ids ex[] <- .finalize_expr_subset(ex[][ filter_bool_feats, - filter_bool_cells + filter_bool_cells, + drop = FALSE ]) } @@ -895,6 +900,16 @@ # # # # Should only be checked for cell_ids subsets + attached_polys <- list_spatial_info_names(gobject) + + if (is.null(poly_info)) { + poly_info <- spat_unit[spat_unit %in% attached_polys] + } + + if (isTRUE(poly_info == ":all:")) { + poly_info <- attached_polys + } + for (select_poly_info in poly_info) { # For each entry entry in poly_info, subset using cell_ids. # Note that even if no poly_info is selected, the overlaps slots @@ -1137,8 +1152,8 @@ if (is.null(x_max)) x_max <- max(comb_metadata[["sdimx"]]) if (is.null(x_min)) x_min <- min(comb_metadata[["sdimx"]]) - comb_metadata <- comb_metadata[get("sdimx") < x_max & - get("sdimx") > x_min] + comb_metadata <- comb_metadata[get("sdimx") <= x_max & + get("sdimx") >= x_min] } # y spatial dimension @@ -1146,8 +1161,8 @@ if (is.null(y_max)) y_max <- max(comb_metadata[["sdimy"]]) if (is.null(y_min)) y_min <- min(comb_metadata[["sdimy"]]) - comb_metadata <- comb_metadata[get("sdimy") < y_max & - get("sdimy") > y_min] + comb_metadata <- comb_metadata[get("sdimy") <= y_max & + get("sdimy") >= y_min] } # z spatial dimension @@ -1155,8 +1170,8 @@ if (is.null(z_max)) z_max <- max(comb_metadata[["sdimz"]]) if (is.null(z_min)) z_min <- min(comb_metadata[["sdimz"]]) - comb_metadata <- comb_metadata[get("sdimz") < z_max & - get("sdimz") > z_min] + comb_metadata <- comb_metadata[get("sdimz") <= z_max & + get("sdimz") >= z_min] } if (return_gobject) { @@ -1407,7 +1422,7 @@ subsetGiotto <- function(gobject, feat_type = "rna", cell_ids = NULL, feat_ids = NULL, - poly_info = NULL, + poly_info = spat_unit, all_spat_units = NULL, all_feat_types = NULL, spat_unit_fsub = ":all:", diff --git a/R/zzz.R b/R/zzz.R index cb62de1d..1d25b9e2 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -7,6 +7,9 @@ GiottoUtils::check_github_suite_ver("GiottoClass") options("giotto.check_version" = FALSE) } - + init_option("giotto.py_path", NULL) + init_option("giotto.init", TRUE) + init_option("giotto.check_valid", TRUE) + init_option("giotto.plotengine3d", "plotly") } diff --git a/inst/extdata/viz_interactive_select.csv b/inst/extdata/viz_interactive_select.csv new file mode 100644 index 00000000..c23d6043 --- /dev/null +++ b/inst/extdata/viz_interactive_select.csv @@ -0,0 +1,40 @@ +"","x","y","name" +"1",6425.22739495473,-4731.2084196259,"polygon1" +"2",6389.47789256765,-4802.70742440005,"polygon1" +"3",6393.60283515077,-4889.33121864567,"polygon1" +"4",6454.1019930366,-4861.83160142484,"polygon1" +"5",6503.60130403409,-4809.58232870526,"polygon1" +"6",6531.10092125492,-4780.70773062339,"polygon1" +"7",6576.47528966929,-4769.70788373506,"polygon1" +"8",6605.34988775116,-4742.20826651423,"polygon1" +"9",6632.84950497199,-4709.20872584923,"polygon1" +"10",6500.85134231201,-4688.58401293361,"polygon1" +"11",6548.97567244846,-4835.70696506505,"polygon2" +"12",6481.60161025743,-4853.58171625859,"polygon2" +"13",6410.10260548327,-4912.70589328338,"polygon2" +"14",6397.7277777339,-4959.45524255879,"polygon2" +"15",6394.97781601181,-5043.32907508232,"polygon2" +"16",6397.7277777339,-5140.95271621627,"polygon2" +"17",6489.85149542368,-5098.32830952398,"polygon2" +"18",6547.60069158742,-5077.70359660836,"polygon2" +"19",6533.850882977,-5035.07918991607,"polygon2" +"20",6543.4757490043,-4947.08041480941,"polygon2" +"21",6569.60038536408,-4908.58095070025,"polygon2" +"22",6639.7244092772,-4875.58141003525,"polygon2" +"23",6664.47406477595,-4842.58186937026,"polygon2" +"24",6595.72502172387,-4812.33229042734,"polygon2" +"25",6755.22280160469,-4694.08393637777,"polygon3" +"26",6751.09785902156,-4773.83282631818,"polygon3" +"27",6745.5979355774,-4872.83144831317,"polygon3" +"28",6733.22310782802,-4926.45570189379,"polygon3" +"29",6755.22280160469,-5004.82961097316,"polygon3" +"30",6767.59762935406,-5043.32907508232,"polygon3" +"31",6749.72287816052,-5103.82823296815,"polygon3" +"32",6729.0981652449,-5139.57773535522,"polygon3" +"33",6799.22218915802,-5145.07765879939,"polygon3" +"34",6876.22111737634,-5121.70298416169,"polygon3" +"35",6907.8456771803,-5054.32892197065,"polygon3" +"36",6902.34575373613,-4893.45616122879,"polygon3" +"37",6833.59671068405,-4875.58141003525,"polygon3" +"38",6822.59686379572,-4780.70773062339,"polygon3" +"39",6817.09694035156,-4689.95899379465,"polygon3" diff --git a/inst/python/g2sd.py b/inst/python/g2sd.py index 5f7d2233..7e15559c 100644 --- a/inst/python/g2sd.py +++ b/inst/python/g2sd.py @@ -5,18 +5,23 @@ from xarray import DataArray import geopandas as gpd from shapely.geometry import Point -import os +import glob, os from spatialdata import SpatialData from spatialdata.models import Image2DModel, ShapesModel, TableModel from spatialdata.transformations.transformations import Identity -def createImageModel(): +def createImageModel(temp): images = {} - hires_image_path = "temp_image.png" - hires_img = imread(hires_image_path).squeeze().transpose(2,0,1) - hires_img = DataArray(hires_img, dims=("c","y","x")) - images["hires_image"] = Image2DModel.parse(hires_img, transformations={"downscaled_hires": Identity()}) + image_paths = glob.glob(temp+"*.png") + for path in image_paths: + image = imread(path).squeeze() + if len(image.shape) == 2: + image = np.expand_dims(image, axis=-1) + image = image.transpose(2,0,1) + image = DataArray(image, dims=("c","y","x")) + image_name = os.path.splitext(os.path.basename(path))[0] + images[image_name] = Image2DModel.parse(image) return images def createShapeModel(spat_locs, spot_radius): @@ -33,15 +38,19 @@ def createShapeModel(spat_locs, spot_radius): return shapes def createTableModel(temp): - alist = os.listdir(temp)[0] - adata = ad.read_h5ad(os.path.join(temp, alist)) + alist = glob.glob(temp+"*.h5ad") + adata = ad.read_h5ad(alist[0]) table = TableModel.parse(adata) return table -def createSpatialData(temp, spat_locs, spot_radius, save_directory): - images = createImageModel() +def createSpatialData(temp, spat_locs, spot_radius, save_directory, image_exists): + if image_exists: + images = createImageModel(temp) table = createTableModel(temp) shapes = createShapeModel(spat_locs, spot_radius) - sd = SpatialData(table = table, images = images) + if image_exists: + sd = SpatialData(table = table, images = images) + else: + sd = SpatialData(table = table) sd.shapes["Shapes"] = shapes - sd.write(save_directory) + sd.write(save_directory, overwrite = True) diff --git a/inst/python/sd2g.py b/inst/python/sd2g.py index c63aee1e..f6b8af88 100644 --- a/inst/python/sd2g.py +++ b/inst/python/sd2g.py @@ -28,17 +28,17 @@ def read_spatialdata_from_path(sd_path = None): # Extract gene expression def extract_expression(sdata = None): expr = sdata.table.X.transpose().todense() - expr_df = pd.DataFrame(expr, index=sdata.table.var['gene_ids'].index, columns=sdata.table.obs['array_row'].index) + expr_df = pd.DataFrame(expr, index=sdata.table.var.index, columns=sdata.table.obs.index) return expr_df # Extract cell IDs def extract_cell_IDs(sdata = None): - cell_IDs = sdata.table.obs['array_row'].index.tolist() + cell_IDs = sdata.table.obs.index.tolist() return cell_IDs # Extract feature IDs def extract_feat_IDs(sdata = None): - feat_IDs = sdata.table.var['gene_ids'].index.tolist() + feat_IDs = sdata.table.var.index.tolist() return feat_IDs # Metadata @@ -124,17 +124,23 @@ def parse_obsm_for_spat_locs(sdata = None): spat_locs["sdimy"] = -1 * spat_locs["sdimy"] return spat_locs -# Extract hires image +# Extract images def extract_image(sdata = None): - # Find SpatialData image name for hires image - for key in sdata.images.keys(): - if "hires" in key: - hires_image_name = key + # Retrieve the list of images + image_list = list(sdata.images.keys()) # Extract image from SpatialData and convert it to numpy array - hires_image = sdata.images[hires_image_name] - hires_image_array = np.transpose(hires_image.compute().data, (1, 2, 0)) # Transpose to (y, x, c) - return hires_image_array + extracted_images = [] + for image_key in image_list: + image = sdata.images[image_key] + image_array = np.transpose(image.compute().data, (1, 2, 0)) # Transpose to (y, x, c) + extracted_images.append(image_array) + return extracted_images + +# Extract image names +def extract_image_names(sdata = None): + image_names = list(sdata.images.keys()) + return image_names # Extract PCA def extract_pca(sdata = None): @@ -240,7 +246,6 @@ def extract_NN_connectivities(sdata = None, key_added = None): for nk in nn_key_list: if "connectivities" in nk: connectivities = sdata.table.obsp[nk] - return connectivities def extract_NN_distances(sdata = None, key_added = None): @@ -318,7 +323,7 @@ def find_SN_keys(sdata = None, key_added = None): with open(key_added) as f: for line in f.readlines(): line = line.strip() - line_key_added = line + suffix + line_key_added = line + "_" + suffix line_keys.append(line_key_added) for key in line_keys: map_keys = sdata.table.uns[key].keys() diff --git a/man/XY.Rd b/man/XY.Rd new file mode 100644 index 00000000..e2ac848e --- /dev/null +++ b/man/XY.Rd @@ -0,0 +1,71 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/methods-XY.R +\name{XY} +\alias{XY} +\alias{XY<-} +\alias{XY,spatLocsObj-method} +\alias{XY<-,spatLocsObj,matrix-method} +\alias{XY,giottoPoints-method} +\alias{XY<-,giottoPoints,ANY-method} +\alias{XY,giottoPolygon-method} +\alias{XY<-,giottoPolygon,ANY-method} +\alias{XY,SpatVector-method} +\alias{XY<-,SpatVector,matrix-method} +\title{Spatial coordinates} +\usage{ +\S4method{XY}{spatLocsObj}(x, ...) + +\S4method{XY}{spatLocsObj,matrix}(x) <- value + +\S4method{XY}{giottoPoints}(x, ...) + +\S4method{XY}{giottoPoints,ANY}(x, ...) <- value + +\S4method{XY}{giottoPolygon}(x, ...) + +\S4method{XY}{giottoPolygon,ANY}(x, ...) <- value + +\S4method{XY}{SpatVector}(x, include_geom = FALSE, ...) + +\S4method{XY}{SpatVector,matrix}(x, ...) <- value +} +\arguments{ +\item{x}{object} + +\item{...}{additional args to pass} + +\item{value}{matrix. xy(z) coordinates to set} + +\item{include_geom}{logical. Whether \code{geom}, \code{part}, and \code{hole} from the +terra geometry matrix should be included.} +} +\value{ +\code{XY()} returns \code{matrix}. \verb{XY<-()} returns same class as \code{x} +} +\description{ +Directly get and set the xy(z) coordinates of spatial +subobjects (currently \code{spatLocsObj}, \code{giottoPoints}, \code{giottoPolygon}). +coordinate values are retrieved and set as \code{matrix}. +} +\examples{ +sl <- GiottoData::loadSubObjectMini("spatLocsObj") +gpoly <- GiottoData::loadSubObjectMini("giottoPolygon") +gpoints <- GiottoData::loadSubObjectMini("giottoPoints") + +m1 <- XY(sl) +plot(sl) +XY(sl) <- m1 + 1000 +plot(sl) + +m2 <- XY(gpoints) +plot(gpoints) +XY(gpoints) <- m2 * 2 + 1000 +plot(gpoints) + +m3 <- XY(gpoly) +plot(gpoly) +XY(gpoly) <- m3 / 2 +plot(gpoly) + +XY(gpoly[1:10]) # vertices from first 10 polys +} diff --git a/man/annotateGiotto.Rd b/man/annotateGiotto.Rd index ebc25089..b7002459 100644 --- a/man/annotateGiotto.Rd +++ b/man/annotateGiotto.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/auxilliary.R \name{annotateGiotto} \alias{annotateGiotto} -\title{Annotate giotto clustering} +\title{Annotate Giotto object} \usage{ annotateGiotto( gobject, @@ -14,23 +14,26 @@ annotateGiotto( ) } \arguments{ -\item{gobject}{giotto object} +\item{gobject}{\code{giotto} object} \item{spat_unit}{spatial unit} \item{feat_type}{feature type} -\item{annotation_vector}{named annotation vector (names = cluster ids)} +\item{annotation_vector}{named \code{character} vector. Vector names are labels +in the cluster column. Labels to assign are the vector values.} -\item{cluster_column}{cluster column to convert to annotation names} +\item{cluster_column}{\code{character}. Cell metaadata column to map annotation +values based on.} \item{name}{new name for annotation column} } \value{ -giotto object +\code{giotto} object } \description{ -Converts cluster results into a user provided annotation. +Map user provided annotations/labels based on another +existing metadata column (usually clustering labels) } \details{ You need to specify which (cluster) column you want to annotate diff --git a/man/area.Rd b/man/area.Rd new file mode 100644 index 00000000..38ac744d --- /dev/null +++ b/man/area.Rd @@ -0,0 +1,37 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/methods-area.R +\name{area} +\alias{area} +\alias{area,giottoPolygon-method} +\alias{area,SpatVector-method} +\title{Get the area of individual polygons} +\usage{ +\S4method{area}{giottoPolygon}(x, ...) + +\S4method{area}{SpatVector}(x, ...) +} +\arguments{ +\item{x}{\code{giottoPolygon}} + +\item{...}{additional args to pass} +} +\value{ +\code{numeric} vector of spatial area +} +\description{ +Compute the area covered by polygons +} +\examples{ +sl <- GiottoData::loadSubObjectMini("spatLocsObj") +gpoly <- GiottoData::loadSubObjectMini("giottoPolygon") +gpoints <- GiottoData::loadSubObjectMini("giottoPoints") + +# area of polygons +area(gpoly) + +# area of the convex hull +area(convHull(sl)) +feature_hulls <- convHull(gpoints, by = "feat_ID") +area(feature_hulls) + +} diff --git a/man/as.character.Rd b/man/as.character.Rd index a7a56969..21b006ee 100644 --- a/man/as.character.Rd +++ b/man/as.character.Rd @@ -15,6 +15,9 @@ \item{...}{additional params to pass (none implemented)} } +\value{ +character +} \description{ Create a text representation of an object } diff --git a/man/as.list.Rd b/man/as.list.Rd new file mode 100644 index 00000000..2fcc8635 --- /dev/null +++ b/man/as.list.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/methods-extract.R +\docType{methods} +\name{as.list,giotto-method} +\alias{as.list,giotto-method} +\title{Coerce to a list} +\usage{ +\S4method{as.list}{giotto}(x, slots, spat_unit = NULL, feat_type = NULL, name = NULL, ...) +} +\arguments{ +\item{x}{the object to coerce} + +\item{slots}{character vector. Which data slots to include in list. See +details} + +\item{spat_unit}{spatial unit (e.g. "cell")} + +\item{feat_type}{feature type to use (e.g. "rna", "protein")} + +\item{name}{name of the elements to select from the slot} + +\item{\dots}{additional arguments} +} +\value{ +list +} +\description{ +Generic to coerce to a list if possible +} +\details{ +\itemize{ +\item Giotto method - the slots argument currently accepts any or multiple of: +\verb{"spatial_info", "spatial_locs", "spatial_network", "feat_info", "expression", "cell_metadata", "feat_metadata", "spatial_enrichment", "nn_network", "dimension_reduction", "multiomics"} +} +} diff --git a/man/as.points.Rd b/man/as.points.Rd index b9eff351..8f305f0f 100644 --- a/man/as.points.Rd +++ b/man/as.points.Rd @@ -3,9 +3,12 @@ \name{as.points} \alias{as.points} \alias{as.points,data.frame-method} +\alias{as.points,spatLocsObj-method} \title{Coerce to SpatVector points} \usage{ \S4method{as.points}{data.frame}(x, include_values = TRUE, specific_values = NULL) + +\S4method{as.points}{spatLocsObj}(x) } \arguments{ \item{x}{SpatRaster, SpatVector, SpatExtent, or correctly formatted diff --git a/man/buffer.Rd b/man/buffer.Rd new file mode 100644 index 00000000..8cdd643a --- /dev/null +++ b/man/buffer.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/buffer.R +\name{buffer} +\alias{buffer} +\alias{buffer,spatLocsObj-method} +\alias{buffer,giottoPoints-method} +\alias{buffer,giottoPolygon-method} +\title{Create a buffer around vector geometries} +\usage{ +\S4method{buffer}{spatLocsObj}(x, width, ..., settle = TRUE) + +\S4method{buffer}{giottoPoints}(x, width, ..., settle = TRUE) + +\S4method{buffer}{giottoPolygon}(x, width, ..., settle = TRUE) +} +\arguments{ +\item{x}{SpatRaster or SpatVector} + +\item{width}{numeric. Unit is meter if \code{x} has a longitude/latitude CRS, or in the units of the coordinate reference system in other cases (typically also meter). The value should be > 0 if \code{x} is a SpatRaster. If \code{x} is a SpatVector, this argument is vectorized, meaning that you can provide a different value for each geometry in \code{x}; and you can also use the name of a variable in \code{x} that has the widths} + +\item{\dots}{additional params to pass} + +\item{settle}{logical. Settle the borders between polygons by cutting them +where they touch based on voronoi boundaries.} +} +\value{ +\code{giottoPolygon} of buffer polygons +} +\description{ +Calculate a buffer around all geometries of a \code{SpatVector} +} +\examples{ +sl <- GiottoData::loadSubObjectMini("spatLocsObj") +slb <- buffer(sl, 30) +plot(slb) +} diff --git a/man/combineMetadata.Rd b/man/combineMetadata.Rd index 2de3c1ae..c55fd4d2 100644 --- a/man/combineMetadata.Rd +++ b/man/combineMetadata.Rd @@ -31,7 +31,7 @@ Extended cell metadata in data.table format. } \description{ This function combines the cell metadata with spatial locations -and enrichment results from \code{\link[Giotto]{runSpatialEnrich}} +and enrichment results from runSpatialEnrich. } \examples{ g <- GiottoData::loadGiottoMini("visium") diff --git a/man/combineSpatialCellFeatureInfo.Rd b/man/combineSpatialCellFeatureInfo.Rd deleted file mode 100644 index cb6f26e3..00000000 --- a/man/combineSpatialCellFeatureInfo.Rd +++ /dev/null @@ -1,40 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/combine_metadata.R -\name{combineSpatialCellFeatureInfo} -\alias{combineSpatialCellFeatureInfo} -\title{combineSpatialCellFeatureInfo} -\usage{ -combineSpatialCellFeatureInfo( - gobject, - spat_unit = NULL, - feat_type = NULL, - selected_features = NULL -) -} -\arguments{ -\item{gobject}{Giotto object} - -\item{spat_unit}{spatial unit} - -\item{feat_type}{feature type(s)} - -\item{selected_features}{select set of features} -} -\value{ -list of data.table(s) -} -\description{ -Combine spatial cell information (e.g. polygon) -and spatial feature information (e.g. transcript locations) -} -\details{ -The returned data.table has the following columns: \cr -\itemize{ -\item{sdimx: spatial feature location on the x-axis} -\item{sdimy: spatial feature location on the y-axis} -\item{feat_ID: unique feature ID} -\item{cell_ID: unique cell ID} -\item{used: how often was the feature used/assigned to a cell} -\item{feat: selected feature(s)} -} -} 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/convert_mgImage_to_array_DT.Rd b/man/convert_mgImage_to_array_DT.Rd index fde53b84..08ac4496 100644 --- a/man/convert_mgImage_to_array_DT.Rd +++ b/man/convert_mgImage_to_array_DT.Rd @@ -21,6 +21,7 @@ g_image <- getGiottoImage(g, name = "image") mgimg <- as(g_image, "giottoImage") a <- convert_mgImage_to_array_DT(mgimg) -force(a);force(a) +force(a) +force(a) } \keyword{internal} diff --git a/man/createGiottoLargeImage.Rd b/man/createGiottoLargeImage.Rd index 9d5efc0a..b062a9ec 100644 --- a/man/createGiottoLargeImage.Rd +++ b/man/createGiottoLargeImage.Rd @@ -22,7 +22,8 @@ createGiottoLargeImage( ) } \arguments{ -\item{raster_object}{terra SpatRaster image object} +\item{raster_object}{filepath to an image, a terra \code{SpatRaster} or, other format +openable via \code{\link[terra:rast]{terra::rast()}}} \item{name}{name for the image} diff --git a/man/createGiottoPolygon.Rd b/man/createGiottoPolygon.Rd index d2a1a542..24df4b18 100644 --- a/man/createGiottoPolygon.Rd +++ b/man/createGiottoPolygon.Rd @@ -121,7 +121,8 @@ poly_IDs. Default = "cell_". See \emph{ID_fmt} section.} \item{copy_dt}{(default TRUE) if segmdfr is provided as dt, this determines whether a copy is made} -\item{maskfile}{path to mask file} +\item{maskfile}{path to mask file, a terra \code{SpatRaster}, or some other +data class readable by \code{\link[terra:rast]{terra::rast()}}} \item{segmdfr}{data.frame-like object with polygon coordinate information (x, y, poly_ID) with x and y being vertex information for the diff --git a/man/createMetafeats.Rd b/man/createMetafeats.Rd index b0f97b78..f86e1c9d 100644 --- a/man/createMetafeats.Rd +++ b/man/createMetafeats.Rd @@ -136,8 +136,10 @@ g <- createMetafeats( # These custom functions must be summary functions, as in, they must # produce only a single numeric output from many custom_stat <- function(x) { - if (max(x) == 0) return(0) - return(mean(x/max(x))) + if (max(x) == 0) { + return(0) + } + return(mean(x / max(x))) } g <- createMetafeats( gobject = g, @@ -159,6 +161,3 @@ g <- createMetafeats( ) showGiottoSpatEnrichments(g) } -\seealso{ -\code{\link[GiottoVisuals:spatCellPlot]{GiottoVisuals::spatCellPlot()}} -} diff --git a/man/data_access_params.Rd b/man/data_access_params.Rd index 0eae4253..3f2522a3 100644 --- a/man/data_access_params.Rd +++ b/man/data_access_params.Rd @@ -10,17 +10,22 @@ \item{feat_type}{feature type (e.g. "rna", "dna", "protein")} -\item{return_uniques}{return unique nesting names (ignores if final object exists/is correct class)} +\item{return_uniques}{return unique nesting names (ignores if final object +exists/is correct class)} \item{output}{what format in which to get information (e.g. "data.table")} -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when +\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE +only when expression and spat_info are not expected to exist.} -\item{copy_obj}{whether to deep copy/duplicate when getting the object (default = TRUE)} +\item{copy_obj}{whether to deep copy/duplicate when getting the object +(default = TRUE)} \item{initialize}{(default = FALSE) whether to initialize the gobject before returning} + +\item{\dots}{additional params to pass} } \value{ data.table diff --git a/man/decomp_affine.Rd b/man/decomp_affine.Rd index 23a7a134..308c4592 100644 --- a/man/decomp_affine.Rd +++ b/man/decomp_affine.Rd @@ -31,7 +31,7 @@ trans_m[seq(2), 3] <- c(200, 300) scale_m <- diag(c(2, 3, 1)) shear_m[2, 1] <- 2 aff_m <- matrix(c( - 2, 0.5, 1000, + 2, 0.5, 1000, -0.3, 3, 20, 100, 29, 1 ), nrow = 3, byrow = TRUE) @@ -58,7 +58,7 @@ sl_aff_piecewise <- sl |> shear(fx = a$shear[["x"]], fy = a$shear[["y"]], x0 = 0, y0 = 0) |> rescale(fx = a$scale[["x"]], fy = a$scale[["y"]], x0 = 0, y0 = 0) |> spatShift(dx = a$translate[["x"]], dy = a$translate[["y"]]) - + plot(affine(sl, shear_m)) plot(sl_shear_piecewise) plot(affine(sl, aff_m)) diff --git a/man/dimnames.Rd b/man/dimnames.Rd index 0be71b51..95871ccf 100644 --- a/man/dimnames.Rd +++ b/man/dimnames.Rd @@ -2,12 +2,26 @@ % Please edit documentation in R/methods-names.R \name{dimnames} \alias{dimnames} +\alias{dimnames,giotto-method} \alias{dimnames,exprObj-method} \alias{dimnames,dimObj-method} +\alias{dimnames,spatLocsObj-method} +\alias{dimnames,metaData-method} +\alias{dimnames,enrData-method} \title{Dimnames of an object} \usage{ +\S4method{dimnames}{giotto}(x) + \S4method{dimnames}{exprObj}(x) +\S4method{dimnames}{dimObj}(x) + +\S4method{dimnames}{spatLocsObj}(x) + +\S4method{dimnames}{metaData}(x) + +\S4method{dimnames}{enrData}(x) + \S4method{dimnames}{dimObj}(x) } \arguments{ @@ -24,3 +38,4 @@ g <- GiottoData::loadSubObjectMini("exprObj") dimnames(g) } +\keyword{internal} diff --git a/man/dims-generic.Rd b/man/dims-generic.Rd index 986ccb3c..ae95bd5e 100644 --- a/man/dims-generic.Rd +++ b/man/dims-generic.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/methods-dims.R \name{dims-generic} \alias{dims-generic} +\alias{nrow,giotto-method} \alias{nrow,giottoPoints-method} \alias{nrow,giottoPolygon-method} \alias{nrow,spatLocsObj-method} @@ -10,10 +11,12 @@ \alias{nrow,spatialNetworkObj-method} \alias{nrow,enrData-method} \alias{nrow,dimObj-method} +\alias{ncol,giotto-method} \alias{ncol,exprData-method} \alias{ncol,metaData-method} \alias{ncol,enrData-method} \alias{ncol,dimObj-method} +\alias{dim,giotto-method} \alias{dim,spatLocsObj-method} \alias{dim,exprData-method} \alias{dim,metaData-method} @@ -23,6 +26,8 @@ \alias{dim,giottoPoints-method} \title{Dimensions of giotto objects} \usage{ +\S4method{nrow}{giotto}(x) + \S4method{nrow}{giottoPoints}(x) \S4method{nrow}{giottoPolygon}(x) @@ -39,6 +44,8 @@ \S4method{nrow}{dimObj}(x) +\S4method{ncol}{giotto}(x) + \S4method{ncol}{exprData}(x) \S4method{ncol}{metaData}(x) @@ -47,6 +54,8 @@ \S4method{ncol}{dimObj}(x) +\S4method{dim}{giotto}(x) + \S4method{dim}{spatLocsObj}(x) \S4method{dim}{exprData}(x) diff --git a/man/doDeferred.Rd b/man/doDeferred.Rd new file mode 100644 index 00000000..c384843c --- /dev/null +++ b/man/doDeferred.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/images.R +\name{doDeferred} +\alias{doDeferred} +\alias{doDeferred,giottoAffineImage-method} +\title{Perform deferred/lazy operations} +\usage{ +\S4method{doDeferred}{giottoAffineImage}(x, size = 5e+05, filename = NULL, ...) +} +\arguments{ +\item{x}{object to force deferred operations in} + +\item{size}{numeric. Minimum number of image pixels to render when +evaluating} + +\item{filename}{character. Full filepath to write the rendered image to. If +\code{NULL}, a file in \code{tempdir()} will be generated.} + +\item{...}{additional args to pass} +} +\description{ +Force deferred/lazy operations. +} +\examples{ +gimg <- GiottoData::loadSubObjectMini("giottoLargeImage") +affimg <- spin(gimg, 45) # lazily performs affine + +# force the affine operation and render the output with at least 5e5 px +gimg2 <- doDeferred(affimg, size = 5e5) +# **This is mainly intended for visualization.** +# This process saves with image depth of 8. +# Spatially transformed raster values are not preferred for analysis +} diff --git a/man/dot-create_spatvector_object_from_dfr.Rd b/man/dot-create_spatvector_object_from_dfr.Rd index 31663bf8..19b126c6 100644 --- a/man/dot-create_spatvector_object_from_dfr.Rd +++ b/man/dot-create_spatvector_object_from_dfr.Rd @@ -9,7 +9,7 @@ x_colname = NULL, y_colname = NULL, feat_ID_colname = NULL, - verbose = TRUE + verbose = NULL ) } \arguments{ diff --git a/man/dot-install_giotto_environment.Rd b/man/dot-install_giotto_environment.Rd index bb39be5e..d11c4ed2 100644 --- a/man/dot-install_giotto_environment.Rd +++ b/man/dot-install_giotto_environment.Rd @@ -7,7 +7,8 @@ .install_giotto_environment( force_environment = FALSE, packages_to_install = c("pandas", "networkx", "python-igraph", "leidenalg", - "python-louvain", "python.app", "scikit-learn"), + "python-louvain", "python.app", "scikit-learn", "smfishhmrf", "session-info"), + pip_packages = c("python-louvain", "smfishhmrf", "session-info"), python_version = "3.10.2", mini_install_path = NULL, confirm = TRUE, diff --git a/man/dot-merge_spatial_locs_feat_info.Rd b/man/dot-merge_spatial_locs_feat_info.Rd deleted file mode 100644 index 34841d55..00000000 --- a/man/dot-merge_spatial_locs_feat_info.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/combine_metadata.R -\name{.merge_spatial_locs_feat_info} -\alias{.merge_spatial_locs_feat_info} -\title{.merge_spatial_locs_feat_info} -\usage{ -.merge_spatial_locs_feat_info(spatial_info, feature_info) -} -\value{ -data.table -} -\description{ -merge spatial cell and feature location information -} -\keyword{internal} diff --git a/man/ext.Rd b/man/ext.Rd index 2e1fa453..5d74fc80 100644 --- a/man/ext.Rd +++ b/man/ext.Rd @@ -11,11 +11,13 @@ \alias{ext,giottoImage-method} \alias{ext,giotto-method} \alias{ext,giottoAffineImage-method} +\alias{ext,affine2d-method} \alias{ext<-,giottoPoints,SpatExtent-method} \alias{ext<-,giottoPolygon,SpatExtent-method} \alias{ext<-,giottoLargeImage,SpatExtent-method} \alias{ext<-,ANY,ANY-method} \alias{ext<-,giottoImage,SpatExtent-method} +\alias{ext<-,affine2d,ANY-method} \title{Get a SpatExtent} \usage{ \S4method{ext}{spatLocsObj}(x, ...) @@ -43,6 +45,8 @@ \S4method{ext}{giottoAffineImage}(x, ...) +\S4method{ext}{affine2d}(x, ...) + \S4method{ext}{giottoPoints,SpatExtent}(x) <- value \S4method{ext}{giottoPolygon,SpatExtent}(x) <- value @@ -52,6 +56,8 @@ \S4method{ext}{ANY,ANY}(x) <- value \S4method{ext}{giottoImage,SpatExtent}(x) <- value + +\S4method{ext}{affine2d,ANY}(x) <- value } \arguments{ \item{x}{spatial object} diff --git a/man/featType-generic.Rd b/man/featType-generic.Rd index d1887f8d..1b31f06f 100644 --- a/man/featType-generic.Rd +++ b/man/featType-generic.Rd @@ -4,16 +4,22 @@ \alias{featType-generic} \alias{featType} \alias{featType<-} +\alias{featType,ANY-method} \alias{featType,list-method} \alias{featType,featData-method} \alias{featType<-,featData-method} +\alias{featType<-,list-method} \title{Feature type information} \usage{ +\S4method{featType}{ANY}(x) + \S4method{featType}{list}(x) \S4method{featType}{featData}(x) \S4method{featType}{featData}(x) <- value + +\S4method{featType}{list}(x) <- value } \arguments{ \item{x}{a Giotto S4 class subobject with feature type} @@ -28,6 +34,8 @@ access and set feat_type slot of S4 subobject } \section{Functions}{ \itemize{ +\item \code{featType(ANY)}: Get feature type information + \item \code{featType(featData)}: Get feature type information \item \code{featType(featData) <- value}: Set feature type information diff --git a/man/getCellMetadata.Rd b/man/getCellMetadata.Rd index eac18d12..5bad2f3d 100644 --- a/man/getCellMetadata.Rd +++ b/man/getCellMetadata.Rd @@ -22,9 +22,11 @@ getCellMetadata( \item{output}{return as either 'data.table' or 'cellMetaObj'} -\item{copy_obj}{whether to deep copy/duplicate when getting the object (default = TRUE)} +\item{copy_obj}{whether to deep copy/duplicate when getting the object +(default = TRUE)} -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when +\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE +only when expression and spat_info are not expected to exist.} } \value{ @@ -40,4 +42,20 @@ getCellMetadata(g) } \seealso{ pDataDT + +Other functions to get data from giotto object: +\code{\link{getDimReduction}()}, +\code{\link{getExpression}()}, +\code{\link{getFeatureInfo}()}, +\code{\link{getFeatureMetadata}()}, +\code{\link{getGiottoImage}()}, +\code{\link{getMultiomics}()}, +\code{\link{getNearestNetwork}()}, +\code{\link{getPolygonInfo}()}, +\code{\link{getSpatialEnrichment}()}, +\code{\link{getSpatialGrid}()}, +\code{\link{getSpatialLocations}()}, +\code{\link{getSpatialNetwork}()}, +\code{\link{get_multiomics}()} } +\concept{functions to get data from giotto object} diff --git a/man/getDimReduction.Rd b/man/getDimReduction.Rd index 22833c13..31275d50 100644 --- a/man/getDimReduction.Rd +++ b/man/getDimReduction.Rd @@ -9,8 +9,8 @@ getDimReduction( spat_unit = NULL, feat_type = NULL, reduction = c("cells", "feats"), - reduction_method = c("pca", "umap", "tsne"), - name = "pca", + reduction_method = NULL, + name = NULL, output = c("dimObj", "matrix"), set_defaults = TRUE ) @@ -31,7 +31,8 @@ getDimReduction( \item{output}{object type to return as. Either 'dimObj' (default) or 'matrix' of the embedding coordinates.} -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when +\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE +only when expression and spat_info are not expected to exist.} } \value{ @@ -47,13 +48,13 @@ getDimReduction(g) } \seealso{ Other dimensional reduction data accessor functions: -\code{\link{get_dimReduction}()}, -\code{\link{setDimReduction}()}, -\code{\link{set_dimReduction}()} +\code{\link{setDimReduction}()} Other functions to get data from giotto object: +\code{\link{getCellMetadata}()}, \code{\link{getExpression}()}, \code{\link{getFeatureInfo}()}, +\code{\link{getFeatureMetadata}()}, \code{\link{getGiottoImage}()}, \code{\link{getMultiomics}()}, \code{\link{getNearestNetwork}()}, @@ -62,16 +63,7 @@ Other functions to get data from giotto object: \code{\link{getSpatialGrid}()}, \code{\link{getSpatialLocations}()}, \code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} +\code{\link{get_multiomics}()} } \concept{dimensional reduction data accessor functions} \concept{functions to get data from giotto object} diff --git a/man/getExpression.Rd b/man/getExpression.Rd index f0c01d45..f757ab73 100644 --- a/man/getExpression.Rd +++ b/man/getExpression.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/slot_accessors.R \name{getExpression} \alias{getExpression} +\alias{getExpressionValues} \title{Get expression values} \usage{ getExpression( @@ -27,7 +28,8 @@ extract (e.g. "raw", "normalized", "scaled")} either matrix' for the matrix object contained in the exprObj or 'exprObj' (default) for the exprObj itself are allowed.} -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when +\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE +only when expression and spat_info are not expected to exist.} } \value{ @@ -43,12 +45,13 @@ getExpression(g) } \seealso{ Other expression accessor functions: -\code{\link{setExpression}()}, -\code{\link{set_expression_values}()} +\code{\link{setExpression}()} Other functions to get data from giotto object: +\code{\link{getCellMetadata}()}, \code{\link{getDimReduction}()}, \code{\link{getFeatureInfo}()}, +\code{\link{getFeatureMetadata}()}, \code{\link{getGiottoImage}()}, \code{\link{getMultiomics}()}, \code{\link{getNearestNetwork}()}, @@ -57,16 +60,7 @@ Other functions to get data from giotto object: \code{\link{getSpatialGrid}()}, \code{\link{getSpatialLocations}()}, \code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} +\code{\link{get_multiomics}()} } \concept{expression accessor functions} \concept{functions to get data from giotto object} diff --git a/man/getFeatureInfo.Rd b/man/getFeatureInfo.Rd index 9a3176ef..99c4db6b 100644 --- a/man/getFeatureInfo.Rd +++ b/man/getFeatureInfo.Rd @@ -19,7 +19,8 @@ getFeatureInfo( \item{return_giottoPoints}{return as a giottoPoints object} -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when +\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE +only when expression and spat_info are not expected to exist.} \item{simplify}{logical. Whether or not to take object out of a list when @@ -38,13 +39,13 @@ getFeatureInfo(g) } \seealso{ Other feature info data accessor functions: -\code{\link{get_feature_info}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{set_feature_info}()} +\code{\link{setFeatureInfo}()} Other functions to get data from giotto object: +\code{\link{getCellMetadata}()}, \code{\link{getDimReduction}()}, \code{\link{getExpression}()}, +\code{\link{getFeatureMetadata}()}, \code{\link{getGiottoImage}()}, \code{\link{getMultiomics}()}, \code{\link{getNearestNetwork}()}, @@ -53,16 +54,7 @@ Other functions to get data from giotto object: \code{\link{getSpatialGrid}()}, \code{\link{getSpatialLocations}()}, \code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} +\code{\link{get_multiomics}()} } \concept{feature info data accessor functions} \concept{functions to get data from giotto object} diff --git a/man/getFeatureMetadata.Rd b/man/getFeatureMetadata.Rd index 818d544e..f2998103 100644 --- a/man/getFeatureMetadata.Rd +++ b/man/getFeatureMetadata.Rd @@ -24,7 +24,8 @@ getFeatureMetadata( \item{copy_obj}{whether to perform a deepcopy of the data.table information} -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when +\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE +only when expression and spat_info are not expected to exist.} } \value{ @@ -40,4 +41,20 @@ getFeatureMetadata(g) } \seealso{ fDataDT + +Other functions to get data from giotto object: +\code{\link{getCellMetadata}()}, +\code{\link{getDimReduction}()}, +\code{\link{getExpression}()}, +\code{\link{getFeatureInfo}()}, +\code{\link{getGiottoImage}()}, +\code{\link{getMultiomics}()}, +\code{\link{getNearestNetwork}()}, +\code{\link{getPolygonInfo}()}, +\code{\link{getSpatialEnrichment}()}, +\code{\link{getSpatialGrid}()}, +\code{\link{getSpatialLocations}()}, +\code{\link{getSpatialNetwork}()}, +\code{\link{get_multiomics}()} } +\concept{functions to get data from giotto object} diff --git a/man/getGiottoImage.Rd b/man/getGiottoImage.Rd index 8c51614d..5d34e724 100644 --- a/man/getGiottoImage.Rd +++ b/man/getGiottoImage.Rd @@ -27,14 +27,14 @@ getGiottoImage(gobject = g) } \seealso{ Other image data accessor functions: -\code{\link{get_giottoImage}()}, -\code{\link{setGiottoImage}()}, -\code{\link{set_giottoImage}()} +\code{\link{setGiottoImage}()} Other functions to get data from giotto object: +\code{\link{getCellMetadata}()}, \code{\link{getDimReduction}()}, \code{\link{getExpression}()}, \code{\link{getFeatureInfo}()}, +\code{\link{getFeatureMetadata}()}, \code{\link{getMultiomics}()}, \code{\link{getNearestNetwork}()}, \code{\link{getPolygonInfo}()}, @@ -42,16 +42,7 @@ Other functions to get data from giotto object: \code{\link{getSpatialGrid}()}, \code{\link{getSpatialLocations}()}, \code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} +\code{\link{get_multiomics}()} } \concept{functions to get data from giotto object} \concept{image data accessor functions} diff --git a/man/getMultiomics.Rd b/man/getMultiomics.Rd index baa67fc8..19de8e47 100644 --- a/man/getMultiomics.Rd +++ b/man/getMultiomics.Rd @@ -45,9 +45,11 @@ Other multiomics accessor functions: \code{\link{set_multiomics}()} Other functions to get data from giotto object: +\code{\link{getCellMetadata}()}, \code{\link{getDimReduction}()}, \code{\link{getExpression}()}, \code{\link{getFeatureInfo}()}, +\code{\link{getFeatureMetadata}()}, \code{\link{getGiottoImage}()}, \code{\link{getNearestNetwork}()}, \code{\link{getPolygonInfo}()}, @@ -55,16 +57,7 @@ Other functions to get data from giotto object: \code{\link{getSpatialGrid}()}, \code{\link{getSpatialLocations}()}, \code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} +\code{\link{get_multiomics}()} } \concept{functions to get data from giotto object} \concept{multiomics accessor functions} diff --git a/man/getNearestNetwork.Rd b/man/getNearestNetwork.Rd index 4b1f8d51..349865da 100644 --- a/man/getNearestNetwork.Rd +++ b/man/getNearestNetwork.Rd @@ -28,7 +28,8 @@ getNearestNetwork( \item{output}{return a giotto \code{nnNetObj}, \code{igraph}, \code{data.table} object. Default 'nnNetObj'} -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when +\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE +only when expression and spat_info are not expected to exist.} } \value{ @@ -44,14 +45,14 @@ getNearestNetwork(gobject = g) } \seealso{ Other expression space nearest network accessor functions: -\code{\link{get_NearestNetwork}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{set_NearestNetwork}()} +\code{\link{setNearestNetwork}()} Other functions to get data from giotto object: +\code{\link{getCellMetadata}()}, \code{\link{getDimReduction}()}, \code{\link{getExpression}()}, \code{\link{getFeatureInfo}()}, +\code{\link{getFeatureMetadata}()}, \code{\link{getGiottoImage}()}, \code{\link{getMultiomics}()}, \code{\link{getPolygonInfo}()}, @@ -59,16 +60,7 @@ Other functions to get data from giotto object: \code{\link{getSpatialGrid}()}, \code{\link{getSpatialLocations}()}, \code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} +\code{\link{get_multiomics}()} } \concept{expression space nearest network accessor functions} \concept{functions to get data from giotto object} diff --git a/man/getPolygonInfo.Rd b/man/getPolygonInfo.Rd index bb2117a5..1b2ea5ab 100644 --- a/man/getPolygonInfo.Rd +++ b/man/getPolygonInfo.Rd @@ -41,14 +41,14 @@ getPolygonInfo(g) } \seealso{ Other polygon info data accessor functions: -\code{\link{get_polygon_info}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{set_polygon_info}()} +\code{\link{setPolygonInfo}()} Other functions to get data from giotto object: +\code{\link{getCellMetadata}()}, \code{\link{getDimReduction}()}, \code{\link{getExpression}()}, \code{\link{getFeatureInfo}()}, +\code{\link{getFeatureMetadata}()}, \code{\link{getGiottoImage}()}, \code{\link{getMultiomics}()}, \code{\link{getNearestNetwork}()}, @@ -56,16 +56,7 @@ Other functions to get data from giotto object: \code{\link{getSpatialGrid}()}, \code{\link{getSpatialLocations}()}, \code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} +\code{\link{get_multiomics}()} } \concept{functions to get data from giotto object} \concept{polygon info data accessor functions} diff --git a/man/getSpatialEnrichment.Rd b/man/getSpatialEnrichment.Rd index 230465de..c1f80f61 100644 --- a/man/getSpatialEnrichment.Rd +++ b/man/getSpatialEnrichment.Rd @@ -25,9 +25,11 @@ getSpatialEnrichment( \item{output}{what format in which to get information (e.g. "data.table")} -\item{copy_obj}{whether to deep copy/duplicate when getting the object (default = TRUE)} +\item{copy_obj}{whether to deep copy/duplicate when getting the object +(default = TRUE)} -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when +\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE +only when expression and spat_info are not expected to exist.} } \value{ @@ -43,14 +45,14 @@ getSpatialEnrichment(g, spat_unit = "aggregate", name = "cluster_metagene") } \seealso{ Other spatial enrichment data accessor functions: -\code{\link{get_spatial_enrichment}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{set_spatial_enrichment}()} +\code{\link{setSpatialEnrichment}()} Other functions to get data from giotto object: +\code{\link{getCellMetadata}()}, \code{\link{getDimReduction}()}, \code{\link{getExpression}()}, \code{\link{getFeatureInfo}()}, +\code{\link{getFeatureMetadata}()}, \code{\link{getGiottoImage}()}, \code{\link{getMultiomics}()}, \code{\link{getNearestNetwork}()}, @@ -58,16 +60,7 @@ Other functions to get data from giotto object: \code{\link{getSpatialGrid}()}, \code{\link{getSpatialLocations}()}, \code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} +\code{\link{get_multiomics}()} } \concept{functions to get data from giotto object} \concept{spatial enrichment data accessor functions} diff --git a/man/getSpatialGrid.Rd b/man/getSpatialGrid.Rd index d36ccc9b..2678f371 100644 --- a/man/getSpatialGrid.Rd +++ b/man/getSpatialGrid.Rd @@ -24,7 +24,8 @@ getSpatialGrid( \item{return_grid_Obj}{return grid object (default = FALSE)} -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when +\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE +only when expression and spat_info are not expected to exist.} } \value{ @@ -41,14 +42,14 @@ getSpatialGrid(g) } \seealso{ Other spatial grid data accessor functions: -\code{\link{get_spatialGrid}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{set_spatialGrid}()} +\code{\link{setSpatialGrid}()} Other functions to get data from giotto object: +\code{\link{getCellMetadata}()}, \code{\link{getDimReduction}()}, \code{\link{getExpression}()}, \code{\link{getFeatureInfo}()}, +\code{\link{getFeatureMetadata}()}, \code{\link{getGiottoImage}()}, \code{\link{getMultiomics}()}, \code{\link{getNearestNetwork}()}, @@ -56,16 +57,7 @@ Other functions to get data from giotto object: \code{\link{getSpatialEnrichment}()}, \code{\link{getSpatialLocations}()}, \code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} +\code{\link{get_multiomics}()} } \concept{functions to get data from giotto object} \concept{spatial grid data accessor functions} diff --git a/man/getSpatialLocations.Rd b/man/getSpatialLocations.Rd index 3c65f070..0afdbfe4 100644 --- a/man/getSpatialLocations.Rd +++ b/man/getSpatialLocations.Rd @@ -31,7 +31,8 @@ object (default = TRUE)} \item{verbose}{be verbose} -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when +\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE +only when expression and spat_info are not expected to exist.} \item{simplify}{logical. Whether or not to take object out of a list when @@ -50,14 +51,14 @@ getSpatialLocations(g) } \seealso{ Other spatial location data accessor functions: -\code{\link{get_spatial_locations}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{set_spatial_locations}()} +\code{\link{setSpatialLocations}()} Other functions to get data from giotto object: +\code{\link{getCellMetadata}()}, \code{\link{getDimReduction}()}, \code{\link{getExpression}()}, \code{\link{getFeatureInfo}()}, +\code{\link{getFeatureMetadata}()}, \code{\link{getGiottoImage}()}, \code{\link{getMultiomics}()}, \code{\link{getNearestNetwork}()}, @@ -65,16 +66,7 @@ Other functions to get data from giotto object: \code{\link{getSpatialEnrichment}()}, \code{\link{getSpatialGrid}()}, \code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} +\code{\link{get_multiomics}()} } \concept{functions to get data from giotto object} \concept{spatial location data accessor functions} diff --git a/man/getSpatialNetwork.Rd b/man/getSpatialNetwork.Rd index 251a6af0..ff48bab6 100644 --- a/man/getSpatialNetwork.Rd +++ b/man/getSpatialNetwork.Rd @@ -26,7 +26,8 @@ getSpatialNetwork( 'spatialNetworkObj' (default), 'networkDT' and 'networkDT_before_filter' for data.table outputs.} -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when +\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE +only when expression and spat_info are not expected to exist.} \item{copy_obj}{whether to copy/duplicate when getting the @@ -50,14 +51,14 @@ getSpatialNetwork(g) } \seealso{ Other spatial network data accessor functions: -\code{\link{get_spatialNetwork}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_spatialNetwork}()} +\code{\link{setSpatialNetwork}()} Other functions to get data from giotto object: +\code{\link{getCellMetadata}()}, \code{\link{getDimReduction}()}, \code{\link{getExpression}()}, \code{\link{getFeatureInfo}()}, +\code{\link{getFeatureMetadata}()}, \code{\link{getGiottoImage}()}, \code{\link{getMultiomics}()}, \code{\link{getNearestNetwork}()}, @@ -65,16 +66,7 @@ Other functions to get data from giotto object: \code{\link{getSpatialEnrichment}()}, \code{\link{getSpatialGrid}()}, \code{\link{getSpatialLocations}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} +\code{\link{get_multiomics}()} } \concept{functions to get data from giotto object} \concept{spatial network data accessor functions} diff --git a/man/get_NearestNetwork.Rd b/man/get_NearestNetwork.Rd deleted file mode 100644 index e0b1de78..00000000 --- a/man/get_NearestNetwork.Rd +++ /dev/null @@ -1,68 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_NearestNetwork} -\alias{get_NearestNetwork} -\title{Get nearest network} -\usage{ -get_NearestNetwork( - gobject, - spat_unit = NULL, - feat_type = NULL, - nn_network_to_use = NULL, - network_name = NULL, - output = c("nnNetObj", "igraph", "data.table"), - set_defaults = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{nn_network_to_use}{"kNN" or "sNN"} - -\item{network_name}{name of NN network to be used} - -\item{output}{return a igraph or data.table object. Default 'igraph'} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} -} -\value{ -igraph or data.table object -} -\description{ -Get a NN-network from a Giotto object -} -\seealso{ -Other expression space nearest network accessor functions: -\code{\link{getNearestNetwork}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{set_NearestNetwork}()} - -Other functions to get data from giotto object: -\code{\link{getDimReduction}()}, -\code{\link{getExpression}()}, -\code{\link{getFeatureInfo}()}, -\code{\link{getGiottoImage}()}, -\code{\link{getMultiomics}()}, -\code{\link{getNearestNetwork}()}, -\code{\link{getPolygonInfo}()}, -\code{\link{getSpatialEnrichment}()}, -\code{\link{getSpatialGrid}()}, -\code{\link{getSpatialLocations}()}, -\code{\link{getSpatialNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} -} -\concept{expression space nearest network accessor functions} -\concept{functions to get data from giotto object} diff --git a/man/get_cell_id.Rd b/man/get_cell_id.Rd deleted file mode 100644 index f29b4812..00000000 --- a/man/get_cell_id.Rd +++ /dev/null @@ -1,61 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_cell_id} -\alias{get_cell_id} -\title{Get cell IDs for a given spatial unit} -\usage{ -get_cell_id(gobject, spat_unit = NULL, set_defaults = TRUE) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} -} -\value{ -character vector of cell_IDs -} -\description{ -Data for each spatial unit is expected to agree on a single -set of cell_IDs that are shared across any feature types. These cell_IDs -are stored within the giotto object's \code{cell_ID} slot. Getters and -setters for this slot directly retrieve (get) or replace (set) this slot. -} -\seealso{ -set_cell_id - -Other functions to set data in giotto object: -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{functions to set data in giotto object} -\keyword{internal} diff --git a/man/get_cell_metadata.Rd b/man/get_cell_metadata.Rd deleted file mode 100644 index 9ea820dd..00000000 --- a/man/get_cell_metadata.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_cell_metadata} -\alias{get_cell_metadata} -\title{Get cell metadata} -\usage{ -get_cell_metadata( - gobject, - spat_unit = NULL, - feat_type = NULL, - output = c("cellMetaObj", "data.table"), - copy_obj = TRUE, - set_defaults = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{output}{return as either 'data.table' or 'cellMetaObj'} - -\item{copy_obj}{whether to deep copy/duplicate when getting the object (default = TRUE)} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} -} -\value{ -a data.table or cellMetaObj -} -\description{ -Get cell metadata from giotto object -} -\seealso{ -pDataDT -} -\keyword{internal} diff --git a/man/get_dimReduction.Rd b/man/get_dimReduction.Rd deleted file mode 100644 index 15ffab3c..00000000 --- a/man/get_dimReduction.Rd +++ /dev/null @@ -1,72 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_dimReduction} -\alias{get_dimReduction} -\title{Get dimension reduction} -\usage{ -get_dimReduction( - gobject, - spat_unit = NULL, - feat_type = NULL, - reduction = c("cells", "feats"), - reduction_method = c("pca", "umap", "tsne"), - name = "pca", - output = c("dimObj", "matrix"), - set_defaults = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{reduction}{reduction on cells or features (e.g. "cells", "feats")} - -\item{reduction_method}{reduction method (e.g. "pca", "umap", "tsne")} - -\item{name}{name of reduction results} - -\item{output}{object type to return as. Either 'dimObj' (default) or 'matrix' -of the embedding coordinates.} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} -} -\value{ -dim reduction object (default) or dim reduction coordinates -} -\description{ -Function to get a dimension reduction object -} -\seealso{ -Other dimensional reduction data accessor functions: -\code{\link{getDimReduction}()}, -\code{\link{setDimReduction}()}, -\code{\link{set_dimReduction}()} - -Other functions to get data from giotto object: -\code{\link{getDimReduction}()}, -\code{\link{getExpression}()}, -\code{\link{getFeatureInfo}()}, -\code{\link{getGiottoImage}()}, -\code{\link{getMultiomics}()}, -\code{\link{getNearestNetwork}()}, -\code{\link{getPolygonInfo}()}, -\code{\link{getSpatialEnrichment}()}, -\code{\link{getSpatialGrid}()}, -\code{\link{getSpatialLocations}()}, -\code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} -} -\concept{dimensional reduction data accessor functions} -\concept{functions to get data from giotto object} diff --git a/man/get_expression_values.Rd b/man/get_expression_values.Rd deleted file mode 100644 index 28aba2a0..00000000 --- a/man/get_expression_values.Rd +++ /dev/null @@ -1,38 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_expression_values} -\alias{get_expression_values} -\title{get_expression_values} -\usage{ -get_expression_values( - gobject, - spat_unit = NULL, - feat_type = NULL, - values = c("raw", "normalized", "scaled"), - output = c("exprObj", "matrix"), - set_defaults = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{values}{expression values to -extract (e.g. "raw", "normalized", "scaled")} - -\item{output}{what object type to retrieve the expression as. Currently -either matrix' for the matrix object contained in the exprObj or -'exprObj' (default) for the exprObj itself are allowed.} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} -} -\value{ -exprObj or matrix depending on output param -} -\description{ -get_expression_values -} diff --git a/man/get_feat_id.Rd b/man/get_feat_id.Rd deleted file mode 100644 index 35bdfeed..00000000 --- a/man/get_feat_id.Rd +++ /dev/null @@ -1,61 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_feat_id} -\alias{get_feat_id} -\title{Get feat IDs for a given feature type} -\usage{ -get_feat_id(gobject, feat_type = NULL, set_defaults = TRUE) -} -\arguments{ -\item{gobject}{giotto object} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} -} -\value{ -character -} -\description{ -Across a single modality/feature type, all feature information -is expected to share a single set of feat_IDs. These feat_IDs are stored -within the giotto object's \code{feat_ID} slot. Getters and setters for this -slot directly (get) or replace (set) this slot. -} -\seealso{ -set_feat_id - -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{functions to set data in giotto object} -\keyword{internal} diff --git a/man/get_feature_info.Rd b/man/get_feature_info.Rd deleted file mode 100644 index 906c91c0..00000000 --- a/man/get_feature_info.Rd +++ /dev/null @@ -1,64 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_feature_info} -\alias{get_feature_info} -\title{Get feature info} -\usage{ -get_feature_info( - gobject, - feat_type = NULL, - set_defaults = TRUE, - return_giottoPoints = FALSE, - simplify = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{return_giottoPoints}{return as a giottoPoints object} - -\item{simplify}{logical. Whether or not to take object out of a list when -there is a length of 1.} -} -\value{ -a SpatVector (default) or giottoPoints object depending on value of -return_giottoPoints -} -\description{ -Get giotto points spatVector -} -\seealso{ -Other feature info data accessor functions: -\code{\link{getFeatureInfo}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{set_feature_info}()} - -Other functions to get data from giotto object: -\code{\link{getDimReduction}()}, -\code{\link{getExpression}()}, -\code{\link{getFeatureInfo}()}, -\code{\link{getGiottoImage}()}, -\code{\link{getMultiomics}()}, -\code{\link{getNearestNetwork}()}, -\code{\link{getPolygonInfo}()}, -\code{\link{getSpatialEnrichment}()}, -\code{\link{getSpatialGrid}()}, -\code{\link{getSpatialLocations}()}, -\code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} -} -\concept{feature info data accessor functions} -\concept{functions to get data from giotto object} diff --git a/man/get_feature_metadata.Rd b/man/get_feature_metadata.Rd deleted file mode 100644 index 423dfaa3..00000000 --- a/man/get_feature_metadata.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_feature_metadata} -\alias{get_feature_metadata} -\title{Get feature metadata} -\usage{ -get_feature_metadata( - gobject, - spat_unit = NULL, - feat_type = NULL, - output = c("featMetaObj", "data.table"), - copy_obj = TRUE, - set_defaults = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{output}{return as either 'data.table' or 'featMetaObj'} - -\item{copy_obj}{whether to perform a deepcopy of the data.table information} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} -} -\value{ -a data.table or featMetaObj -} -\description{ -Get feature metadata from giotto object -} -\seealso{ -fDataDT -} -\keyword{internal} diff --git a/man/get_giottoImage.Rd b/man/get_giottoImage.Rd deleted file mode 100644 index 38eb9768..00000000 --- a/man/get_giottoImage.Rd +++ /dev/null @@ -1,51 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_giottoImage} -\alias{get_giottoImage} -\title{Get giotto image object} -\usage{ -get_giottoImage(gobject = NULL, image_type = NULL, name = NULL) -} -\arguments{ -\item{gobject}{giotto object} - -\item{image_type}{deprecated} - -\item{name}{name of a giotto image object \code{\link{showGiottoImageNames}}} -} -\value{ -a giotto image object -} -\description{ -Get giotto image object from gobject -} -\seealso{ -Other image data accessor functions: -\code{\link{getGiottoImage}()}, -\code{\link{setGiottoImage}()}, -\code{\link{set_giottoImage}()} - -Other functions to get data from giotto object: -\code{\link{getDimReduction}()}, -\code{\link{getExpression}()}, -\code{\link{getFeatureInfo}()}, -\code{\link{getGiottoImage}()}, -\code{\link{getMultiomics}()}, -\code{\link{getNearestNetwork}()}, -\code{\link{getPolygonInfo}()}, -\code{\link{getSpatialEnrichment}()}, -\code{\link{getSpatialGrid}()}, -\code{\link{getSpatialLocations}()}, -\code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} -} -\concept{functions to get data from giotto object} -\concept{image data accessor functions} diff --git a/man/get_giottoImage_MG.Rd b/man/get_giottoImage_MG.Rd deleted file mode 100644 index 3a28437c..00000000 --- a/man/get_giottoImage_MG.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_giottoImage_MG} -\alias{get_giottoImage_MG} -\title{Get \emph{magick}-based giotto \code{image}} -\usage{ -get_giottoImage_MG(gobject, name = NULL) -} -\arguments{ -\item{gobject}{giotto object} - -\item{name}{name of giottoImage \code{\link{showGiottoImageNames}}} -} -\value{ -a giottoImage -} -\description{ -Get a giottoImage from a giotto object -} -\keyword{internal} diff --git a/man/get_giottoLargeImage.Rd b/man/get_giottoLargeImage.Rd deleted file mode 100644 index bd3af696..00000000 --- a/man/get_giottoLargeImage.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_giottoLargeImage} -\alias{get_giottoLargeImage} -\title{Get \emph{terra}-based giotto \code{largeImage}} -\usage{ -get_giottoLargeImage(gobject, name = NULL) -} -\arguments{ -\item{gobject}{giotto object} - -\item{name}{name of giottoLargeImage \code{\link{showGiottoImageNames}}} -} -\value{ -a giottoLargeImage -} -\description{ -Set a giottoLargeImage from a giottoObject -} -\keyword{internal} diff --git a/man/get_multiomics.Rd b/man/get_multiomics.Rd index 8eaebd73..4d797aee 100644 --- a/man/get_multiomics.Rd +++ b/man/get_multiomics.Rd @@ -45,9 +45,11 @@ Other multiomics accessor functions: \code{\link{set_multiomics}()} Other functions to get data from giotto object: +\code{\link{getCellMetadata}()}, \code{\link{getDimReduction}()}, \code{\link{getExpression}()}, \code{\link{getFeatureInfo}()}, +\code{\link{getFeatureMetadata}()}, \code{\link{getGiottoImage}()}, \code{\link{getMultiomics}()}, \code{\link{getNearestNetwork}()}, @@ -55,16 +57,7 @@ Other functions to get data from giotto object: \code{\link{getSpatialEnrichment}()}, \code{\link{getSpatialGrid}()}, \code{\link{getSpatialLocations}()}, -\code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} +\code{\link{getSpatialNetwork}()} } \concept{functions to get data from giotto object} \concept{multiomics accessor functions} diff --git a/man/get_polygon_info.Rd b/man/get_polygon_info.Rd deleted file mode 100644 index 396b79d1..00000000 --- a/man/get_polygon_info.Rd +++ /dev/null @@ -1,67 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_polygon_info} -\alias{get_polygon_info} -\title{Get polygon info} -\usage{ -get_polygon_info( - gobject, - polygon_name = NULL, - polygon_overlap = NULL, - return_giottoPolygon = FALSE, - verbose = TRUE, - simplify = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{polygon_name}{name of polygons. Default "cell"} - -\item{polygon_overlap}{if not NULL, return specified polygon overlap -information} - -\item{return_giottoPolygon}{(Defaults to FALSE) Return as giottoPolygon S4 -object} - -\item{verbose}{be verbose} - -\item{simplify}{logical. Whether or not to take object out of a list when -there is a length of 1.} -} -\value{ -spatVector -} -\description{ -Get giotto polygon spatVector -} -\seealso{ -Other polygon info data accessor functions: -\code{\link{getPolygonInfo}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{set_polygon_info}()} - -Other functions to get data from giotto object: -\code{\link{getDimReduction}()}, -\code{\link{getExpression}()}, -\code{\link{getFeatureInfo}()}, -\code{\link{getGiottoImage}()}, -\code{\link{getMultiomics}()}, -\code{\link{getNearestNetwork}()}, -\code{\link{getPolygonInfo}()}, -\code{\link{getSpatialEnrichment}()}, -\code{\link{getSpatialGrid}()}, -\code{\link{getSpatialLocations}()}, -\code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} -} -\concept{functions to get data from giotto object} -\concept{polygon info data accessor functions} diff --git a/man/get_spatialGrid.Rd b/man/get_spatialGrid.Rd deleted file mode 100644 index eb20100b..00000000 --- a/man/get_spatialGrid.Rd +++ /dev/null @@ -1,65 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_spatialGrid} -\alias{get_spatialGrid} -\title{Get spatial grid} -\usage{ -get_spatialGrid( - gobject, - spat_unit = NULL, - feat_type = NULL, - name = NULL, - return_grid_Obj = FALSE, - set_defaults = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{name}{name of spatial grid} - -\item{return_grid_Obj}{return grid object (default = FALSE)} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} -} -\value{ -spatialGridObj -} -\description{ -Function to get spatial grid -} -\seealso{ -Other spatial grid data accessor functions: -\code{\link{getSpatialGrid}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{set_spatialGrid}()} - -Other functions to get data from giotto object: -\code{\link{getDimReduction}()}, -\code{\link{getExpression}()}, -\code{\link{getFeatureInfo}()}, -\code{\link{getGiottoImage}()}, -\code{\link{getMultiomics}()}, -\code{\link{getNearestNetwork}()}, -\code{\link{getPolygonInfo}()}, -\code{\link{getSpatialEnrichment}()}, -\code{\link{getSpatialGrid}()}, -\code{\link{getSpatialLocations}()}, -\code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} -} -\concept{functions to get data from giotto object} -\concept{spatial grid data accessor functions} diff --git a/man/get_spatialNetwork.Rd b/man/get_spatialNetwork.Rd deleted file mode 100644 index f1591680..00000000 --- a/man/get_spatialNetwork.Rd +++ /dev/null @@ -1,75 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_spatialNetwork} -\alias{get_spatialNetwork} -\title{Get spatial network} -\usage{ -get_spatialNetwork( - gobject, - spat_unit = NULL, - name = NULL, - output = c("spatialNetworkObj", "networkDT", "networkDT_before_filter", "outputObj"), - set_defaults = TRUE, - copy_obj = TRUE, - verbose = TRUE, - simplify = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{name}{name of spatial network} - -\item{output}{object type to return as. Options: -'spatialNetworkObj' (default), -'networkDT' and 'networkDT_before_filter' for data.table outputs.} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{copy_obj}{whether to copy/duplicate when getting the -object (default = TRUE)} - -\item{verbose}{be verbose} - -\item{simplify}{logical. Whether or not to take object out of a list when -there is a length of 1.} -} -\value{ -spatialNetworkObj of data.table -} -\description{ -Function to get a spatial network -} -\seealso{ -Other spatial network data accessor functions: -\code{\link{getSpatialNetwork}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_spatialNetwork}()} - -Other functions to get data from giotto object: -\code{\link{getDimReduction}()}, -\code{\link{getExpression}()}, -\code{\link{getFeatureInfo}()}, -\code{\link{getGiottoImage}()}, -\code{\link{getMultiomics}()}, -\code{\link{getNearestNetwork}()}, -\code{\link{getPolygonInfo}()}, -\code{\link{getSpatialEnrichment}()}, -\code{\link{getSpatialGrid}()}, -\code{\link{getSpatialLocations}()}, -\code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{get_spatial_locations}()} -} -\concept{functions to get data from giotto object} -\concept{spatial network data accessor functions} diff --git a/man/get_spatial_enrichment.Rd b/man/get_spatial_enrichment.Rd deleted file mode 100644 index 066b62e1..00000000 --- a/man/get_spatial_enrichment.Rd +++ /dev/null @@ -1,68 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_spatial_enrichment} -\alias{get_spatial_enrichment} -\title{Get spatial enrichment} -\usage{ -get_spatial_enrichment( - gobject, - spat_unit = NULL, - feat_type = NULL, - enrichm_name = "DWLS", - output = c("spatEnrObj", "data.table"), - copy_obj = TRUE, - set_defaults = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{enrichm_name}{name of spatial enrichment results. Default "DWLS"} - -\item{output}{what format in which to get information (e.g. "data.table")} - -\item{copy_obj}{whether to deep copy/duplicate when getting the object (default = TRUE)} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} -} -\value{ -spatEnrObj or data.table with fractions -} -\description{ -Function to get a spatial enrichment data.table -} -\seealso{ -Other spatial enrichment data accessor functions: -\code{\link{getSpatialEnrichment}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{set_spatial_enrichment}()} - -Other functions to get data from giotto object: -\code{\link{getDimReduction}()}, -\code{\link{getExpression}()}, -\code{\link{getFeatureInfo}()}, -\code{\link{getGiottoImage}()}, -\code{\link{getMultiomics}()}, -\code{\link{getNearestNetwork}()}, -\code{\link{getPolygonInfo}()}, -\code{\link{getSpatialEnrichment}()}, -\code{\link{getSpatialGrid}()}, -\code{\link{getSpatialLocations}()}, -\code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_locations}()} -} -\concept{functions to get data from giotto object} -\concept{spatial enrichment data accessor functions} diff --git a/man/get_spatial_locations.Rd b/man/get_spatial_locations.Rd deleted file mode 100644 index 40d15f65..00000000 --- a/man/get_spatial_locations.Rd +++ /dev/null @@ -1,75 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{get_spatial_locations} -\alias{get_spatial_locations} -\title{Get spatial locations} -\usage{ -get_spatial_locations( - gobject, - spat_unit = NULL, - spat_loc_name = NULL, - output = c("spatLocsObj", "data.table"), - copy_obj = TRUE, - verbose = TRUE, - set_defaults = TRUE, - simplify = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{spat_loc_name}{name of spatial -locations (defaults to first name in spatial_locs slot, e.g. "raw")} - -\item{output}{what object type to get the spatial locations as. Default is as -a 'spatLocsObj'. Returning as 'data.table' is also possible.} - -\item{copy_obj}{whether to copy/duplicate when getting the -object (default = TRUE)} - -\item{verbose}{be verbose} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{simplify}{logical. Whether or not to take object out of a list when -there is a length of 1.} -} -\value{ -data.table with coordinates or spatLocsObj depending on \code{output} -} -\description{ -Function to get a spatial location data.table -} -\seealso{ -Other spatial location data accessor functions: -\code{\link{getSpatialLocations}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{set_spatial_locations}()} - -Other functions to get data from giotto object: -\code{\link{getDimReduction}()}, -\code{\link{getExpression}()}, -\code{\link{getFeatureInfo}()}, -\code{\link{getGiottoImage}()}, -\code{\link{getMultiomics}()}, -\code{\link{getNearestNetwork}()}, -\code{\link{getPolygonInfo}()}, -\code{\link{getSpatialEnrichment}()}, -\code{\link{getSpatialGrid}()}, -\code{\link{getSpatialLocations}()}, -\code{\link{getSpatialNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{get_dimReduction}()}, -\code{\link{get_feature_info}()}, -\code{\link{get_giottoImage}()}, -\code{\link{get_multiomics}()}, -\code{\link{get_polygon_info}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{get_spatial_enrichment}()} -} -\concept{functions to get data from giotto object} -\concept{spatial location data accessor functions} diff --git a/man/giotto-class.Rd b/man/giotto-class.Rd index 2172cff7..2993377d 100644 --- a/man/giotto-class.Rd +++ b/man/giotto-class.Rd @@ -9,7 +9,7 @@ giotto object } \description{ -\pkg{Giotto}'s core object that encapsulates all the components +Giotto's core object that encapsulates all the components of a spatial-omic project and facilitates analyses. } \details{ diff --git a/man/giottoAffineImage-class.Rd b/man/giottoAffineImage-class.Rd index d0b229d2..7955b7ff 100644 --- a/man/giottoAffineImage-class.Rd +++ b/man/giottoAffineImage-class.Rd @@ -4,9 +4,16 @@ \name{giottoAffineImage-class} \alias{giottoAffineImage-class} \title{S4 giottoAffineImage Class} +\value{ +\code{giottoAffineImage} +} \description{ Class extending \code{giottoLargeImage}. When \code{shear()} or \code{spin()} operations -are performed on +are performed on a \code{giottoLargeImage}, this class is instantiated. It +provides a way of storing the affine transformation and also lazily +performing it when required for a plotting preview. It is possible to force +the deferred affine transform using \code{doDeferred()} and return a processed +\code{giottoLargeImage}. } \section{Slots}{ @@ -15,6 +22,6 @@ are performed on transforms} \item{\code{funs}}{list of functions associated with the object. Primarily to -perform the delayed/lazy operations} +perform the delayed/lazy operation} }} diff --git a/man/giotto_instructions.Rd b/man/giotto_instructions.Rd index 97bf5db6..da3e4ca9 100644 --- a/man/giotto_instructions.Rd +++ b/man/giotto_instructions.Rd @@ -5,12 +5,15 @@ \alias{giotto_instructions} \alias{instructions} \alias{instructions<-} +\alias{instructions,missing,missing-method} \alias{instructions,giotto,missing-method} +\alias{instructions,giotto,character-method} +\alias{instructions,giottoInstructions,character-method} \alias{instructions<-,giotto,missing,missing-method} \alias{instructions<-,giotto,missing,logical-method} -\alias{instructions,giotto,character-method} \alias{instructions<-,giotto,character,missing-method} \alias{instructions<-,giotto,character,logical-method} +\alias{instructions<-,giottoInstructions,character,ANY-method} \title{Giotto instructions} \usage{ createGiottoInstructions( @@ -30,17 +33,23 @@ createGiottoInstructions( no_python_warn = FALSE ) +\S4method{instructions}{missing,missing}(gobject, param, ...) + \S4method{instructions}{giotto,missing}(gobject) +\S4method{instructions}{giotto,character}(gobject, param) + +\S4method{instructions}{giottoInstructions,character}(gobject, param) + \S4method{instructions}{giotto,missing,missing}(gobject, initialize) <- value \S4method{instructions}{giotto,missing,logical}(gobject, initialize) <- value -\S4method{instructions}{giotto,character}(gobject, param) - \S4method{instructions}{giotto,character,missing}(gobject, param, initialize) <- value \S4method{instructions}{giotto,character,logical}(gobject, param, initialize) <- value + +\S4method{instructions}{giottoInstructions,character,ANY}(gobject, param) <- value } \arguments{ \item{python_path}{path to python binary to use or directory one level @@ -77,12 +86,14 @@ been detected} \item{gobject}{giotto object} +\item{param}{Specific param in instructions to access or modify} + +\item{\dots}{params to pass to \code{createGiottoInstructions()}} + \item{initialize}{(boolean, default = TRUE) whether to initialize the giotto object} \item{value}{value to set} - -\item{param}{Specific param in instructions to access or modify} } \value{ \code{giottoInstructions}, instructions settings, or \code{giotto} objects @@ -105,6 +116,9 @@ initialization. \examples{ g <- GiottoData::loadGiottoMini("visium") +# create instructions +ins <- instructions() + # get instructions instrs <- instructions(g) force(instrs) @@ -112,7 +126,7 @@ force(instrs) # get single instructions param instructions(g, "show_plot") -# replace single instruction param +# replace an instruction param instructions(g, "show_plot") <- FALSE instructions(g, "show_plot") diff --git a/man/giotto_python.Rd b/man/giotto_python.Rd index 539326a0..0f24ebdf 100644 --- a/man/giotto_python.Rd +++ b/man/giotto_python.Rd @@ -16,7 +16,9 @@ checkGiottoEnvironment( installGiottoEnvironment( packages_to_install = c("pandas==1.5.1", "networkx==2.8.8", "python-igraph==0.10.2", - "leidenalg==0.9.0", "python-louvain==0.16", "python.app==1.4", "scikit-learn==1.1.3"), + "leidenalg==0.9.0", "python-louvain==0.16", "python.app==1.4", "scikit-learn==1.1.3", + "smfishhmrf", "session-info"), + pip_packages = c("python-louvain", "smfishhmrf", "session-info"), python_version = "3.10.2", mini_install_path = NULL, confirm = TRUE, @@ -48,6 +50,9 @@ Default is chosen by \code{reticulate::install_miniconda()}} \item{packages_to_install}{python modules (packages) to install for Giotto.} +\item{pip_packages}{python packages mush installed with pip, only names +are needed} + \item{python_version}{python version to use within the giotto conda environment. Default is v3.10.2} @@ -70,8 +75,11 @@ executable.} \item{initialize}{force initialization of set python path. Default = TRUE.} } +\value{ +installed Giotto environment +} \description{ -\pkg{Giotto} has several functions that utilize python packages. To +Giotto has several functions that utilize python packages. To facilitate this, utilities are provided for creating, removing, and attaching python environments. Python environments are currently handled entirely through \pkg{reticulate}. @@ -122,10 +130,10 @@ function, which will find an environment and then initialize it. \itemize{ \item \code{checkGiottoEnvironment()}: \itemize{ \item Based on \code{envname}, detect if there a conda or miniconda environment -accessible by \pkg{Giotto}. By default, the \code{envname} \code{"giotto_env"}, then +accessible by Giotto. By default, the \code{envname} \code{"giotto_env"}, then the option \code{"giotto.py_path"} is checked, but an alternative can be provided. -\item Setting \code{envname} as \code{":auto:"} will let \pkg{Giotto} autodetect a python +\item Setting \code{envname} as \code{":auto:"} will let Giotto autodetect a python env to use. See section for \code{set_giotto_python_path()} for details on the autodetection. \item Returns \code{TRUE} if an env is detected and accessible by Giotto. \code{FALSE} @@ -137,7 +145,7 @@ if not. Will not initialize a python environment during detection. \pkg{reticulate}. By default, the envname used will be \code{"giotto_env"}. If another name is used, you will have to provide that envname at the start of a session (see \strong{Choosing an environment} above). \cr This includes a -miniconda installation and also a set of python packages that \pkg{Giotto} +miniconda installation and also a set of python packages that Giotto may often use. See details for further information on setting up an environment with a .yml \item Returns \code{NULL} @@ -207,7 +215,7 @@ Please note that multiple .yml files are provided in the repository for advanced installation and convenience. To install the most up-to-date Giotto environment using a .yml file, open a shell compatible with conda/miniconda and navigate to the directory specified by -\code{system.file(package = "Giotto", "python/configuration")}. Once in this +system.file(package = "Giotto", "python/configuration"). Once in this directory, run the following to create your environment in one step: \preformatted{conda env create -n giotto_env -f ./genv.yml} @@ -221,23 +229,24 @@ checkGiottoEnvironment() # use environment name checkGiottoEnvironment("giotto_env") -# full path +# full path # (use this if a different install location specified with .condarc) if (FALSE) { -checkGiottoEnvironment( - "/Users/example/Library/r-miniconda-arm64/envs/giotto_env/bin/pythonw" -) + checkGiottoEnvironment( + "/Users/example/Library/r-miniconda-arm64/envs/giotto_env/bin/pythonw" + ) } if (FALSE) { -# default environment installation -installGiottoEnvironment() + # default environment installation + installGiottoEnvironment() -# install to alternate location -temp_env <- tempdir() -installGiottoEnvironment(mini_install_path = temp_env) + # install to alternate location + temp_env <- tempdir() + installGiottoEnvironment(mini_install_path = temp_env) } - # detect AND initialize a python environment -set_giotto_python_path() +if (FALSE) { + set_giotto_python_path() +} } \keyword{internal} diff --git a/man/joinGiottoObjects.Rd b/man/joinGiottoObjects.Rd index 86538d5d..1befc024 100644 --- a/man/joinGiottoObjects.Rd +++ b/man/joinGiottoObjects.Rd @@ -99,7 +99,7 @@ g1 <- createGiottoObject(expression = m1) g2 <- createGiottoObject(expression = m2) joinGiottoObjects( - gobject_list = list(g1, g2), + gobject_list = list(g1, g2), gobject_names = c("g1", "g2") ) @@ -113,7 +113,7 @@ joinGiottoObjects( ) # place them right next to each other -# note that this means generated spatial networks will be more likely to +# note that this means generated spatial networks will be more likely to # link across the datasets joinGiottoObjects( list(viz, viz), diff --git a/man/list_cell_metadata.Rd b/man/list_cell_metadata.Rd index d9a74aa2..21959017 100644 --- a/man/list_cell_metadata.Rd +++ b/man/list_cell_metadata.Rd @@ -18,7 +18,8 @@ list_cell_metadata( \item{feat_type}{feature type (e.g. "rna", "dna", "protein")} -\item{return_uniques}{return unique nesting names (ignores if final object exists/is correct class)} +\item{return_uniques}{return unique nesting names (ignores if final object +exists/is correct class)} } \value{ names and locations of available cell metadata as data.table diff --git a/man/list_feat_metadata.Rd b/man/list_feat_metadata.Rd index 6abdbb21..46a42bd3 100644 --- a/man/list_feat_metadata.Rd +++ b/man/list_feat_metadata.Rd @@ -18,7 +18,8 @@ list_feat_metadata( \item{feat_type}{feature type (e.g. "rna", "dna", "protein")} -\item{return_uniques}{return unique nesting names (ignores if final object exists/is correct class)} +\item{return_uniques}{return unique nesting names (ignores if final object +exists/is correct class)} } \value{ names and locations of available feature metadata as data.table diff --git a/man/list_nearest_networks.Rd b/man/list_nearest_networks.Rd index 9db003ae..105c1a47 100644 --- a/man/list_nearest_networks.Rd +++ b/man/list_nearest_networks.Rd @@ -21,7 +21,8 @@ list_nearest_networks( \item{nn_type}{nearest neighbor method (e.g. "sNN", "kNN")} -\item{return_uniques}{return unique nesting names (ignores if final object exists/is correct class)} +\item{return_uniques}{return unique nesting names (ignores if final object +exists/is correct class)} } \value{ names and locations of nearest neighbor networks as a data.table diff --git a/man/list_spatial_grids.Rd b/man/list_spatial_grids.Rd index c2453811..ef1d862e 100644 --- a/man/list_spatial_grids.Rd +++ b/man/list_spatial_grids.Rd @@ -18,7 +18,8 @@ list_spatial_grids( \item{feat_type}{feature type (e.g. "rna", "dna", "protein")} -\item{return_uniques}{return unique nesting names (ignores if final object exists/is correct class)} +\item{return_uniques}{return unique nesting names (ignores if final object +exists/is correct class)} } \value{ data.table of names and locations of available spatial grids. diff --git a/man/list_spatial_locations.Rd b/man/list_spatial_locations.Rd index bd02b6ee..369a89b7 100644 --- a/man/list_spatial_locations.Rd +++ b/man/list_spatial_locations.Rd @@ -11,7 +11,8 @@ list_spatial_locations(gobject, spat_unit = NULL, return_uniques = FALSE) \item{spat_unit}{spatial unit (e.g. "cell")} -\item{return_uniques}{return unique nesting names (ignores if final object exists/is correct class)} +\item{return_uniques}{return unique nesting names (ignores if final object +exists/is correct class)} } \value{ names and locations of available data.table as data.table diff --git a/man/list_spatial_networks.Rd b/man/list_spatial_networks.Rd index 1d52d423..7faee481 100644 --- a/man/list_spatial_networks.Rd +++ b/man/list_spatial_networks.Rd @@ -11,7 +11,8 @@ list_spatial_networks(gobject, spat_unit = NULL, return_uniques = FALSE) \item{spat_unit}{spatial unit (e.g. "cell")} -\item{return_uniques}{return unique nesting names (ignores if final object exists/is correct class)} +\item{return_uniques}{return unique nesting names (ignores if final object +exists/is correct class)} } \value{ data.table of names and locations of available spatial networks, diff --git a/man/makePseudoVisium.Rd b/man/makePseudoVisium.Rd index f658e0db..6f5e3f76 100644 --- a/man/makePseudoVisium.Rd +++ b/man/makePseudoVisium.Rd @@ -4,13 +4,22 @@ \alias{makePseudoVisium} \title{makePseudoVisium} \usage{ -makePseudoVisium(extent = NULL, micron_size = 1, name = "pseudo_visium") +makePseudoVisium( + extent = NULL, + micron_scale = 1, + micron_size = deprecated(), + name = "pseudo_visium" +) } \arguments{ \item{extent}{SpatExtent or anything else a SpatExtent can be extracted or created from} -\item{micron_size}{size of a micrometer relative to spatial coordinates} +\item{micron_scale}{scalefactor needed to convert the target coordinate +space to microns. For supported datasets, this can be found from +\code{instructions(gobject, "micron_scale")}. See details.} + +\item{micron_size}{deprecated. Use \code{micron_scale}} \item{name}{character. (default is 'pseudo_visium') Name of giottoPolygon object to create} @@ -19,17 +28,23 @@ object to create} A giottoPolygon for the pseudo-visium spots. } \description{ -Generates a pseudo-visium grid of spots across a provided -spatial extent +Generates a visium-like array of spots across a provided +spatial extent. } \details{ -This function generates a pseudo-Visium grid of spots based on the -input spatial locations. The micron_size param is used to determine the size -of the spots +This function generates a pseudo-Visium array of spots across the +spatial extent provided. The \code{micron_scale} param is used to determine the +scaling of the array relative to the target coordinate system. +} +\section{\code{micron_scale}}{ + +If \code{a} is microns and \code{b} is dataset coordinate units, \code{micron_scale} is +calculated as \code{a / b}. } + \examples{ e <- ext(0, 2000, 0, 2000) -x <- makePseudoVisium(extent = e, micron_size = 1) +x <- makePseudoVisium(extent = e, micron_scale = 1) plot(x) } \concept{spatial location} diff --git a/man/objHistory.Rd b/man/objHistory.Rd index f9abad18..e35be20c 100644 --- a/man/objHistory.Rd +++ b/man/objHistory.Rd @@ -4,10 +4,12 @@ \alias{objHistory} \title{Giotto object history} \usage{ -objHistory(object) +objHistory(object, summarized = FALSE) } \arguments{ \item{object}{giotto object} + +\item{summarized}{logical. whether print should be summarized} } \value{ list @@ -19,4 +21,5 @@ Print and return giotto object history g <- GiottoData::loadGiottoMini("visium") objHistory(g) +objHistory(g, summarized = TRUE) } diff --git a/man/objName-generic.Rd b/man/objName-generic.Rd index f7250bbf..1c42982b 100644 --- a/man/objName-generic.Rd +++ b/man/objName-generic.Rd @@ -4,6 +4,7 @@ \alias{objName-generic} \alias{objName} \alias{objName<-} +\alias{objName,ANY-method} \alias{objName,list-method} \alias{objName,nameData-method} \alias{objName,giottoPoints-method} @@ -16,6 +17,8 @@ \alias{objName<-,giottoPoints-method} \title{Giotto object name information} \usage{ +\S4method{objName}{ANY}(x) + \S4method{objName}{list}(x) \S4method{objName}{nameData}(x) diff --git a/man/objectlist_name_utils.Rd b/man/objectlist_name_utils.Rd index cfa5026d..0d494250 100644 --- a/man/objectlist_name_utils.Rd +++ b/man/objectlist_name_utils.Rd @@ -28,6 +28,9 @@ used when printing verbose messages about what was made unique} \item{verbose}{be verbose} } +\value{ +list +} \description{ Name wrangling for subobject lists } diff --git a/man/rbind-generic.Rd b/man/rbind-generic.Rd index 1a2978aa..8b89e3bf 100644 --- a/man/rbind-generic.Rd +++ b/man/rbind-generic.Rd @@ -2,10 +2,16 @@ % Please edit documentation in R/methods-rbind.R \name{rbind-generic} \alias{rbind-generic} +\alias{rbind2,cellMetaObj,cellMetaObj-method} +\alias{rbind2,featMetaObj,featMetaObj-method} \alias{rbind2,spatLocsObj,spatLocsObj-method} \alias{rbind2,giottoPolygon,giottoPolygon-method} \title{Combine objects by rows (Giotto-related)} \usage{ +\S4method{rbind2}{cellMetaObj,cellMetaObj}(x, y, ...) + +\S4method{rbind2}{featMetaObj,featMetaObj}(x, y, ...) + \S4method{rbind2}{spatLocsObj,spatLocsObj}(x, y, ...) \S4method{rbind2}{giottoPolygon,giottoPolygon}(x, y, add_list_ID = TRUE, ...) diff --git a/man/reconnect.Rd b/man/reconnect.Rd index b034f60e..ee97f4c1 100644 --- a/man/reconnect.Rd +++ b/man/reconnect.Rd @@ -2,10 +2,13 @@ % Please edit documentation in R/methods-reconnect.R \name{reconnect} \alias{reconnect} +\alias{reconnect,giottoAffineImage-method} \alias{reconnect,giottoLargeImage-method} \alias{reconnect,giottoImage-method} \title{Reconnect a GiottoClass object} \usage{ +\S4method{reconnect}{giottoAffineImage}(x, path = NULL, ...) + \S4method{reconnect}{giottoLargeImage}(x, path = NULL, ...) \S4method{reconnect}{giottoImage}(x, path = NULL, ...) @@ -26,8 +29,10 @@ GiottoClass object Reconnect a GiottoClass object } \examples{ -g <- GiottoData::loadGiottoMini("visium") -g_image <- getGiottoImage(g, image_type = "largeImage") +f <- tempfile() +a <- GiottoData::loadSubObjectMini("giottoLargeImage") +saveRDS(a, f) -reconnect(g_image) +b <- readRDS(f) # expected to be null pointer +b <- reconnect(b) # reconnected to source image } diff --git a/man/relate.Rd b/man/relate.Rd new file mode 100644 index 00000000..14b5067c --- /dev/null +++ b/man/relate.Rd @@ -0,0 +1,84 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/methods-relate.R +\name{relate} +\alias{relate} +\alias{relate,giottoSpatial,giottoSpatial-method} +\alias{relate,giotto,giottoSpatial-method} +\title{Spatial relationships between geometries} +\usage{ +\S4method{relate}{giottoSpatial,giottoSpatial}( + x, + y, + relation, + pairs = TRUE, + na.rm = TRUE, + output = c("data.table", "matrix"), + use_names = TRUE, + ... +) + +\S4method{relate}{giotto,giottoSpatial}( + x, + y, + ..., + what = c("polygon", "spatlocs", "points"), + spat_unit = NULL, + feat_type = NULL, + spat_locs_name = NULL +) +} +\arguments{ +\item{x}{spatial object with records to test} + +\item{y}{spatial object records to test relations against} + +\item{relation}{character. One of "intersects", "touches", "crosses", "overlaps", "within", "contains", "covers", "coveredby", "disjoint". Or a "DE-9IM" string such as "FF*FF****". See \href{https://en.wikipedia.org/wiki/DE-9IM}{wikipedia} or \href{https://docs.geotools.org/stable/userguide/library/jts/dim9.html}{geotools doc}} + +\item{pairs}{logical. If \code{TRUE} a two-column matrix is returned with the indices of the cases where the requested relation is \code{TRUE}. This is especially helpful when dealing with many geometries as the returned value is generally much smaller} + +\item{na.rm}{logical. If \code{TRUE} and \code{pairs=TRUE}, geometries in \code{x} for which there is no related geometry in \code{y} are omitted} + +\item{output}{character. \code{"data.table"} or \code{"matrix"}. \code{"data.table"} is +only possible when \code{pairs=TRUE}} + +\item{use_names}{logical. If \code{TRUE}, \code{pairs=TRUE}, and \code{output="data.table"} +the IDs of the geometries will be used.} + +\item{...}{additional args to pass} + +\item{what}{character. Which type of spatial data in the \code{giotto} object to +relate. One of "polygon", "spatlocs", "points"} + +\item{spat_unit}{spatial unit} + +\item{feat_type}{feature type} + +\item{spat_locs_name}{name of spatlocs to use if what = "spatlocs"} +} +\value{ +\code{data.table} if \code{output="data.table"}. \code{matrix} if \code{output="matrix"} +} +\description{ +\code{relate()} returns a logical matrix indicating the presence or +absence of a specific spatial relationships between the geometries in +x and y. +} +\examples{ +g <- GiottoData::loadGiottoMini("viz") +activeSpatUnit(g) <- "aggregate" +sl <- g[["spatial_locs"]][[1]] +gpoints <- g[["feat_info"]][[1]] +gpoly <- g[["spatial_info"]][[1]] + +res1 <- relate(gpoints, gpoly, relation = "intersects") +res2 <- relate(gpoints, gpoly, relation = "intersects", use_names = FALSE) + +selection <- system.file("extdata/viz_interactive_select.csv", + package = "GiottoClass" +) +select_polys <- createGiottoPolygon(data.table::fread(selection)) +res <- relate(g, select_polys, relation = "intersects") +g[, res[y == "polygon1", x]] +g[, res[y == "polygon2", x]] +g[, res[y == "polygon3", x]] +} diff --git a/man/replace_bracket.Rd b/man/replace_bracket.Rd index 1407978f..acdb92c4 100644 --- a/man/replace_bracket.Rd +++ b/man/replace_bracket.Rd @@ -35,6 +35,8 @@ \alias{[<-,giottoPolygon,missing,missing,ANY-method} \alias{[<-,giottoPolygon,missing,missing,} \alias{[<-,giottoPolygon,missing,missing-method} +\alias{[<-,giottoLargeImage,missing,missing,ANY-method} +\alias{[<-,giottoImage,missing,missing,ANY-method} \alias{[<-,affine2d,missing,missing,ANY-method} \alias{[<-,affine2d,missing,missing,} \alias{[<-,affine2d,missing,missing-method} @@ -60,6 +62,10 @@ \S4method{[}{giottoPolygon,missing,missing,ANY}(x, i, j) <- value +\S4method{[}{giottoLargeImage,missing,missing,ANY}(x, i, j) <- value + +\S4method{[}{giottoImage,missing,missing,ANY}(x, i, j) <- value + \S4method{[}{affine2d,missing,missing,ANY}(x, i, j) <- value } \arguments{ diff --git a/man/replace_dollar.Rd b/man/replace_dollar.Rd index 62146595..8cdc23a3 100644 --- a/man/replace_dollar.Rd +++ b/man/replace_dollar.Rd @@ -3,6 +3,7 @@ \name{replace_dollar} \alias{replace_dollar} \alias{`$<-`} +\alias{$<-,giotto-method} \alias{$<-,coordDataDT-method} \alias{$<-,spatEnrObj-method} \alias{$<-,dimObj-method} @@ -10,6 +11,8 @@ \alias{$<-,terraVectData-method} \title{Replace part of an object with \verb{$<-}} \usage{ +\S4method{$}{giotto}(x, name) <- value + \S4method{$}{coordDataDT}(x, name) <- value \S4method{$}{spatEnrObj}(x, name) <- value diff --git a/man/row-plus-colnames-generic.Rd b/man/row-plus-colnames-generic.Rd index ba9cf466..869ec9c9 100644 --- a/man/row-plus-colnames-generic.Rd +++ b/man/row-plus-colnames-generic.Rd @@ -4,16 +4,21 @@ \alias{row-plus-colnames-generic} \alias{colnames} \alias{rownames} +\alias{colnames,giotto-method} \alias{colnames,exprObj-method} \alias{colnames,cellMetaObj-method} \alias{colnames,featMetaObj-method} \alias{colnames,spatEnrObj-method} \alias{colnames,spatLocsObj-method} \alias{colnames,dimObj-method} +\alias{rownames,giotto-method} \alias{rownames,exprObj-method} \alias{rownames,dimObj-method} +\alias{rownames,metaData-method} \title{Row and column names} \usage{ +\S4method{colnames}{giotto}(x) + \S4method{colnames}{exprObj}(x) \S4method{colnames}{cellMetaObj}(x) @@ -26,9 +31,13 @@ \S4method{colnames}{dimObj}(x) +\S4method{rownames}{giotto}(x) + \S4method{rownames}{exprObj}(x) \S4method{rownames}{dimObj}(x) + +\S4method{rownames}{metaData}(x) } \arguments{ \item{x}{object} @@ -44,3 +53,4 @@ g <- GiottoData::loadSubObjectMini("exprObj") colnames(g) } +\keyword{internal} diff --git a/man/saveGiotto.Rd b/man/saveGiotto.Rd index 1bb605cd..193966bd 100644 --- a/man/saveGiotto.Rd +++ b/man/saveGiotto.Rd @@ -11,7 +11,9 @@ saveGiotto( method = c("RDS", "qs"), method_params = list(), overwrite = FALSE, + export_image = TRUE, image_filetype = "PNG", + include_feat_coord = TRUE, verbose = TRUE, ... ) @@ -29,10 +31,17 @@ saveGiotto( \item{overwrite}{Overwrite existing folders} +\item{export_image}{logical. Write out an image of the format specified by +\code{image_filetype} when saving a \code{giottoLargeImage}. +Future image loads and reconnects will point to this new file.} + \item{image_filetype}{the image filetype to use, see \code{\link[terra]{writeRaster}}. Default is "PNG". For TIFF outputs, try "COG"} +\item{include_feat_coord}{logical. Whether to keep the feature coordinates +when saving. Dropping them can improve performance for large datasets.} + \item{verbose}{be verbose} \item{...}{additional parameters for \code{\link[terra]{writeRaster}}} diff --git a/man/setCellMetadata.Rd b/man/setCellMetadata.Rd index d3e4a93c..e534933d 100644 --- a/man/setCellMetadata.Rd +++ b/man/setCellMetadata.Rd @@ -11,7 +11,8 @@ setCellMetadata( feat_type = NULL, provenance = NULL, verbose = TRUE, - initialize = TRUE + initialize = TRUE, + ... ) } \arguments{ @@ -30,6 +31,8 @@ reset a specified set of cell metadata in the giotto object.} \item{initialize}{(default = FALSE) whether to initialize the gobject before returning} + +\item{...}{additional params to pass} } \value{ giotto object @@ -49,12 +52,11 @@ setCellMetadata(gobject = g, x = createCellMetaObj(m2)) } \seealso{ Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setDimReduction}()}, \code{\link{setExpression}()}, \code{\link{setFeatureInfo}()}, \code{\link{setFeatureMetadata}()}, +\code{\link{setGiotto}()}, \code{\link{setGiottoImage}()}, \code{\link{setMultiomics}()}, \code{\link{setNearestNetwork}()}, @@ -63,20 +65,6 @@ Other functions to set data in giotto object: \code{\link{setSpatialGrid}()}, \code{\link{setSpatialLocations}()}, \code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{set_multiomics}()} } \concept{functions to set data in giotto object} diff --git a/man/setDimReduction.Rd b/man/setDimReduction.Rd index 972f2e8d..37818c2a 100644 --- a/man/setDimReduction.Rd +++ b/man/setDimReduction.Rd @@ -14,7 +14,8 @@ setDimReduction( reduction_method = c("pca", "umap", "tsne"), provenance = NULL, verbose = TRUE, - initialize = TRUE + initialize = TRUE, + ... ) } \arguments{ @@ -39,6 +40,8 @@ specified set of dimension reduction information from the gobject} \item{initialize}{(default = FALSE) whether to initialize the gobject before returning} + +\item{...}{additional params to pass} } \value{ giotto object @@ -55,17 +58,14 @@ setDimReduction(gobject = g, x = dimred) } \seealso{ Other dimensional reduction data accessor functions: -\code{\link{getDimReduction}()}, -\code{\link{get_dimReduction}()}, -\code{\link{set_dimReduction}()} +\code{\link{getDimReduction}()} Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setCellMetadata}()}, \code{\link{setExpression}()}, \code{\link{setFeatureInfo}()}, \code{\link{setFeatureMetadata}()}, +\code{\link{setGiotto}()}, \code{\link{setGiottoImage}()}, \code{\link{setMultiomics}()}, \code{\link{setNearestNetwork}()}, @@ -74,21 +74,7 @@ Other functions to set data in giotto object: \code{\link{setSpatialGrid}()}, \code{\link{setSpatialLocations}()}, \code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{set_multiomics}()} } \concept{dimensional reduction data accessor functions} \concept{functions to set data in giotto object} diff --git a/man/setExpression.Rd b/man/setExpression.Rd index d578ebb7..cc7be0ea 100644 --- a/man/setExpression.Rd +++ b/man/setExpression.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/slot_accessors.R \name{setExpression} \alias{setExpression} +\alias{setExpressionValues} \title{Set expression data} \usage{ setExpression( @@ -12,7 +13,8 @@ setExpression( name = "raw", provenance = NULL, verbose = TRUE, - initialize = TRUE + initialize = TRUE, + ... ) } \arguments{ @@ -34,6 +36,8 @@ information for the giotto object. Pass NULL to remove an expression object} \item{initialize}{(default = FALSE) whether to initialize the gobject before returning} + +\item{...}{additional params to pass} } \value{ giotto object @@ -51,16 +55,14 @@ g <- setExpression(gobject = g, x = createExprObj(m, name = "raw")) } \seealso{ Other expression accessor functions: -\code{\link{getExpression}()}, -\code{\link{set_expression_values}()} +\code{\link{getExpression}()} Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setCellMetadata}()}, \code{\link{setDimReduction}()}, \code{\link{setFeatureInfo}()}, \code{\link{setFeatureMetadata}()}, +\code{\link{setGiotto}()}, \code{\link{setGiottoImage}()}, \code{\link{setMultiomics}()}, \code{\link{setNearestNetwork}()}, @@ -69,21 +71,7 @@ Other functions to set data in giotto object: \code{\link{setSpatialGrid}()}, \code{\link{setSpatialLocations}()}, \code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{set_multiomics}()} } \concept{expression accessor functions} \concept{functions to set data in giotto object} diff --git a/man/setFeatureInfo.Rd b/man/setFeatureInfo.Rd index 303e1eb6..b19037ac 100644 --- a/man/setFeatureInfo.Rd +++ b/man/setFeatureInfo.Rd @@ -4,7 +4,14 @@ \alias{setFeatureInfo} \title{Set feature info} \usage{ -setFeatureInfo(gobject, x, feat_type = NULL, verbose = TRUE, initialize = TRUE) +setFeatureInfo( + gobject, + x, + feat_type = NULL, + verbose = TRUE, + initialize = TRUE, + ... +) } \arguments{ \item{gobject}{giotto object} @@ -18,6 +25,8 @@ will remove the specified giottoPoints object from the giotto object} \item{initialize}{(default = FALSE) whether to initialize the gobject before returning} + +\item{...}{additional params to pass} } \value{ giotto object @@ -33,17 +42,14 @@ setFeatureInfo(gobject = g, x = featinfo) } \seealso{ Other feature info data accessor functions: -\code{\link{getFeatureInfo}()}, -\code{\link{get_feature_info}()}, -\code{\link{set_feature_info}()} +\code{\link{getFeatureInfo}()} Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setCellMetadata}()}, \code{\link{setDimReduction}()}, \code{\link{setExpression}()}, \code{\link{setFeatureMetadata}()}, +\code{\link{setGiotto}()}, \code{\link{setGiottoImage}()}, \code{\link{setMultiomics}()}, \code{\link{setNearestNetwork}()}, @@ -52,21 +58,7 @@ Other functions to set data in giotto object: \code{\link{setSpatialGrid}()}, \code{\link{setSpatialLocations}()}, \code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{set_multiomics}()} } \concept{feature info data accessor functions} \concept{functions to set data in giotto object} diff --git a/man/setFeatureMetadata.Rd b/man/setFeatureMetadata.Rd index 8f48ee9b..a7f8bf91 100644 --- a/man/setFeatureMetadata.Rd +++ b/man/setFeatureMetadata.Rd @@ -11,7 +11,8 @@ setFeatureMetadata( feat_type = NULL, provenance = NULL, verbose = TRUE, - initialize = TRUE + initialize = TRUE, + ... ) } \arguments{ @@ -30,6 +31,8 @@ reset a specified set of feature metadata in the giotto object.} \item{initialize}{(default = FALSE) whether to initialize the gobject before returning} + +\item{...}{additional params to pass} } \value{ giotto object @@ -49,12 +52,11 @@ setFeatureMetadata(gobject = g, x = createFeatMetaObj(m2)) } \seealso{ Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setCellMetadata}()}, \code{\link{setDimReduction}()}, \code{\link{setExpression}()}, \code{\link{setFeatureInfo}()}, +\code{\link{setGiotto}()}, \code{\link{setGiottoImage}()}, \code{\link{setMultiomics}()}, \code{\link{setNearestNetwork}()}, @@ -63,20 +65,6 @@ Other functions to set data in giotto object: \code{\link{setSpatialGrid}()}, \code{\link{setSpatialLocations}()}, \code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{set_multiomics}()} } \concept{functions to set data in giotto object} diff --git a/man/setGiotto.Rd b/man/setGiotto.Rd index 06b45a9a..67caab60 100644 --- a/man/setGiotto.Rd +++ b/man/setGiotto.Rd @@ -64,3 +64,21 @@ g_expression <- GiottoData::loadSubObjectMini("exprObj") setGiotto(gobject = g, x = g_expression) } +\seealso{ +Other functions to set data in giotto object: +\code{\link{setCellMetadata}()}, +\code{\link{setDimReduction}()}, +\code{\link{setExpression}()}, +\code{\link{setFeatureInfo}()}, +\code{\link{setFeatureMetadata}()}, +\code{\link{setGiottoImage}()}, +\code{\link{setMultiomics}()}, +\code{\link{setNearestNetwork}()}, +\code{\link{setPolygonInfo}()}, +\code{\link{setSpatialEnrichment}()}, +\code{\link{setSpatialGrid}()}, +\code{\link{setSpatialLocations}()}, +\code{\link{setSpatialNetwork}()}, +\code{\link{set_multiomics}()} +} +\concept{functions to set data in giotto object} diff --git a/man/setGiottoImage.Rd b/man/setGiottoImage.Rd index 486a4066..15106fed 100644 --- a/man/setGiottoImage.Rd +++ b/man/setGiottoImage.Rd @@ -43,18 +43,15 @@ setGiottoImage(gobject = g, image = gimg) \code{\link{addGiottoImage}} Other image data accessor functions: -\code{\link{getGiottoImage}()}, -\code{\link{get_giottoImage}()}, -\code{\link{set_giottoImage}()} +\code{\link{getGiottoImage}()} Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setCellMetadata}()}, \code{\link{setDimReduction}()}, \code{\link{setExpression}()}, \code{\link{setFeatureInfo}()}, \code{\link{setFeatureMetadata}()}, +\code{\link{setGiotto}()}, \code{\link{setMultiomics}()}, \code{\link{setNearestNetwork}()}, \code{\link{setPolygonInfo}()}, @@ -62,21 +59,7 @@ Other functions to set data in giotto object: \code{\link{setSpatialGrid}()}, \code{\link{setSpatialLocations}()}, \code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{set_multiomics}()} } \concept{functions to set data in giotto object} \concept{image data accessor functions} diff --git a/man/setMultiomics.Rd b/man/setMultiomics.Rd index f684774e..78d9a352 100644 --- a/man/setMultiomics.Rd +++ b/man/setMultiomics.Rd @@ -11,7 +11,8 @@ setMultiomics( feat_type = NULL, integration_method = "WNN", result_name = "theta_weighted_matrix", - verbose = TRUE + verbose = TRUE, + ... ) } \arguments{ @@ -29,6 +30,8 @@ integration (e.g. theta weighted values from runWNN)} \item{result_name}{Default = 'theta_weighted_matrix'} \item{verbose}{be verbose} + +\item{...}{additional params to pass} } \value{ A giotto object @@ -51,13 +54,12 @@ Other multiomics accessor functions: \code{\link{set_multiomics}()} Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setCellMetadata}()}, \code{\link{setDimReduction}()}, \code{\link{setExpression}()}, \code{\link{setFeatureInfo}()}, \code{\link{setFeatureMetadata}()}, +\code{\link{setGiotto}()}, \code{\link{setGiottoImage}()}, \code{\link{setNearestNetwork}()}, \code{\link{setPolygonInfo}()}, @@ -65,21 +67,7 @@ Other functions to set data in giotto object: \code{\link{setSpatialGrid}()}, \code{\link{setSpatialLocations}()}, \code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{set_multiomics}()} } \concept{functions to set data in giotto object} \concept{multiomics accessor functions} diff --git a/man/setNearestNetwork.Rd b/man/setNearestNetwork.Rd index 4ed82da9..2ee260f4 100644 --- a/man/setNearestNetwork.Rd +++ b/man/setNearestNetwork.Rd @@ -13,7 +13,8 @@ setNearestNetwork( name = "sNN.pca", provenance = NULL, verbose = TRUE, - initialize = TRUE + initialize = TRUE, + ... ) } \arguments{ @@ -37,6 +38,8 @@ yet supported.} \item{initialize}{(default = FALSE) whether to initialize the gobject before returning} + +\item{...}{additional params to pass} } \value{ giotto object @@ -52,18 +55,15 @@ setNearestNetwork(gobject = g, x = dimred) } \seealso{ Other expression space nearest network accessor functions: -\code{\link{getNearestNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{set_NearestNetwork}()} +\code{\link{getNearestNetwork}()} Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setCellMetadata}()}, \code{\link{setDimReduction}()}, \code{\link{setExpression}()}, \code{\link{setFeatureInfo}()}, \code{\link{setFeatureMetadata}()}, +\code{\link{setGiotto}()}, \code{\link{setGiottoImage}()}, \code{\link{setMultiomics}()}, \code{\link{setPolygonInfo}()}, @@ -71,21 +71,7 @@ Other functions to set data in giotto object: \code{\link{setSpatialGrid}()}, \code{\link{setSpatialLocations}()}, \code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{set_multiomics}()} } \concept{expression space nearest network accessor functions} \concept{functions to set data in giotto object} diff --git a/man/setPolygonInfo.Rd b/man/setPolygonInfo.Rd index 3890f543..20aeb3cd 100644 --- a/man/setPolygonInfo.Rd +++ b/man/setPolygonInfo.Rd @@ -10,7 +10,8 @@ setPolygonInfo( name = "cell", centroids_to_spatlocs = FALSE, verbose = TRUE, - initialize = TRUE + initialize = TRUE, + ... ) } \arguments{ @@ -30,6 +31,8 @@ to additionally set them as a set of spatial locations (default = FALSE)} \item{initialize}{(default = FALSE) whether to initialize the gobject before returning} + +\item{...}{additional params to pass} } \value{ giotto object @@ -54,18 +57,15 @@ setPolygonInfo(gobject = g, x = polyinfo) } \seealso{ Other polygon info data accessor functions: -\code{\link{getPolygonInfo}()}, -\code{\link{get_polygon_info}()}, -\code{\link{set_polygon_info}()} +\code{\link{getPolygonInfo}()} Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setCellMetadata}()}, \code{\link{setDimReduction}()}, \code{\link{setExpression}()}, \code{\link{setFeatureInfo}()}, \code{\link{setFeatureMetadata}()}, +\code{\link{setGiotto}()}, \code{\link{setGiottoImage}()}, \code{\link{setMultiomics}()}, \code{\link{setNearestNetwork}()}, @@ -73,21 +73,7 @@ Other functions to set data in giotto object: \code{\link{setSpatialGrid}()}, \code{\link{setSpatialLocations}()}, \code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{set_multiomics}()} } \concept{functions to set data in giotto object} \concept{polygon info data accessor functions} diff --git a/man/setSpatialEnrichment.Rd b/man/setSpatialEnrichment.Rd index e18cc891..8b9ed631 100644 --- a/man/setSpatialEnrichment.Rd +++ b/man/setSpatialEnrichment.Rd @@ -12,7 +12,8 @@ setSpatialEnrichment( name = "enrichment", provenance = NULL, verbose = TRUE, - initialize = TRUE + initialize = TRUE, + ... ) } \arguments{ @@ -33,6 +34,8 @@ a specified set of spatial enrichment information from the gobject.} \item{initialize}{(default = FALSE) whether to initialize the gobject before returning} + +\item{...}{additional params to pass} } \value{ giotto object @@ -48,18 +51,15 @@ g <- setSpatialEnrichment(g, spatenrich) } \seealso{ Other spatial enrichment data accessor functions: -\code{\link{getSpatialEnrichment}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{set_spatial_enrichment}()} +\code{\link{getSpatialEnrichment}()} Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setCellMetadata}()}, \code{\link{setDimReduction}()}, \code{\link{setExpression}()}, \code{\link{setFeatureInfo}()}, \code{\link{setFeatureMetadata}()}, +\code{\link{setGiotto}()}, \code{\link{setGiottoImage}()}, \code{\link{setMultiomics}()}, \code{\link{setNearestNetwork}()}, @@ -67,21 +67,7 @@ Other functions to set data in giotto object: \code{\link{setSpatialGrid}()}, \code{\link{setSpatialLocations}()}, \code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{set_multiomics}()} } \concept{functions to set data in giotto object} \concept{spatial enrichment data accessor functions} diff --git a/man/setSpatialGrid.Rd b/man/setSpatialGrid.Rd index 1ad1b94e..6d91c9fc 100644 --- a/man/setSpatialGrid.Rd +++ b/man/setSpatialGrid.Rd @@ -11,7 +11,8 @@ setSpatialGrid( feat_type = NULL, name = NULL, verbose = TRUE, - set_defaults = TRUE + set_defaults = TRUE, + ... ) } \arguments{ @@ -27,8 +28,11 @@ setSpatialGrid( \item{verbose}{be verbose} -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when +\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE +only when expression and spat_info are not expected to exist.} + +\item{...}{additional params to pass} } \value{ giotto object @@ -45,18 +49,15 @@ setSpatialGrid(gobject = g, spatial_grid = sg) } \seealso{ Other spatial grid data accessor functions: -\code{\link{getSpatialGrid}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{set_spatialGrid}()} +\code{\link{getSpatialGrid}()} Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setCellMetadata}()}, \code{\link{setDimReduction}()}, \code{\link{setExpression}()}, \code{\link{setFeatureInfo}()}, \code{\link{setFeatureMetadata}()}, +\code{\link{setGiotto}()}, \code{\link{setGiottoImage}()}, \code{\link{setMultiomics}()}, \code{\link{setNearestNetwork}()}, @@ -64,21 +65,7 @@ Other functions to set data in giotto object: \code{\link{setSpatialEnrichment}()}, \code{\link{setSpatialLocations}()}, \code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{set_multiomics}()} } \concept{functions to set data in giotto object} \concept{spatial grid data accessor functions} diff --git a/man/setSpatialLocations.Rd b/man/setSpatialLocations.Rd index 294d217b..44cf7c62 100644 --- a/man/setSpatialLocations.Rd +++ b/man/setSpatialLocations.Rd @@ -11,7 +11,8 @@ setSpatialLocations( name = "raw", provenance = NULL, verbose = TRUE, - initialize = TRUE + initialize = TRUE, + ... ) } \arguments{ @@ -30,6 +31,8 @@ specified set of spatial locations data.} \item{initialize}{(default = FALSE) whether to initialize the gobject before returning} + +\item{...}{additional params to pass} } \value{ giotto object @@ -51,18 +54,15 @@ setSpatialLocations(gobject = g, x = createSpatLocsObj(sl, name = "raw")) } \seealso{ Other spatial location data accessor functions: -\code{\link{getSpatialLocations}()}, -\code{\link{get_spatial_locations}()}, -\code{\link{set_spatial_locations}()} +\code{\link{getSpatialLocations}()} Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setCellMetadata}()}, \code{\link{setDimReduction}()}, \code{\link{setExpression}()}, \code{\link{setFeatureInfo}()}, \code{\link{setFeatureMetadata}()}, +\code{\link{setGiotto}()}, \code{\link{setGiottoImage}()}, \code{\link{setMultiomics}()}, \code{\link{setNearestNetwork}()}, @@ -70,21 +70,7 @@ Other functions to set data in giotto object: \code{\link{setSpatialEnrichment}()}, \code{\link{setSpatialGrid}()}, \code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{set_multiomics}()} } \concept{functions to set data in giotto object} \concept{spatial location data accessor functions} diff --git a/man/setSpatialNetwork.Rd b/man/setSpatialNetwork.Rd index 7ced7c8c..f1ddfd74 100644 --- a/man/setSpatialNetwork.Rd +++ b/man/setSpatialNetwork.Rd @@ -11,7 +11,8 @@ setSpatialNetwork( name = NULL, provenance = NULL, verbose = TRUE, - initialize = TRUE + initialize = TRUE, + ... ) } \arguments{ @@ -30,6 +31,8 @@ removes a specified set of spatial network information from the gobject.} \item{initialize}{(default = FALSE) whether to initialize the gobject before returning} + +\item{...}{additional params to pass} } \value{ giotto object @@ -45,18 +48,15 @@ setSpatialNetwork(gobject = g, x = spatnet) } \seealso{ Other spatial network data accessor functions: -\code{\link{getSpatialNetwork}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{set_spatialNetwork}()} +\code{\link{getSpatialNetwork}()} Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setCellMetadata}()}, \code{\link{setDimReduction}()}, \code{\link{setExpression}()}, \code{\link{setFeatureInfo}()}, \code{\link{setFeatureMetadata}()}, +\code{\link{setGiotto}()}, \code{\link{setGiottoImage}()}, \code{\link{setMultiomics}()}, \code{\link{setNearestNetwork}()}, @@ -64,21 +64,7 @@ Other functions to set data in giotto object: \code{\link{setSpatialEnrichment}()}, \code{\link{setSpatialGrid}()}, \code{\link{setSpatialLocations}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{set_multiomics}()} } \concept{functions to set data in giotto object} \concept{spatial network data accessor functions} diff --git a/man/set_NearestNetwork.Rd b/man/set_NearestNetwork.Rd deleted file mode 100644 index e78bbb8c..00000000 --- a/man/set_NearestNetwork.Rd +++ /dev/null @@ -1,88 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_NearestNetwork} -\alias{set_NearestNetwork} -\title{Set nearest network} -\usage{ -set_NearestNetwork( - gobject, - nn_network, - spat_unit = NULL, - feat_type = NULL, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{nn_network}{nnNetObj or igraph nearest network object. Data.table not -yet supported.} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{nn_network_to_use}{"kNN" or "sNN"} - -\item{network_name}{name of NN network to be used} - -\item{provenance}{provenance information (optional)} - -\item{verbose}{be verbose} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{initialize}{(default = FALSE) whether to initialize the gobject before -returning} -} -\value{ -giotto object -} -\description{ -Set a NN-network for a Giotto object -} -\seealso{ -Other expression space nearest network accessor functions: -\code{\link{getNearestNetwork}()}, -\code{\link{get_NearestNetwork}()}, -\code{\link{setNearestNetwork}()} - -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{expression space nearest network accessor functions} -\concept{functions to set data in giotto object} diff --git a/man/set_cell_id.Rd b/man/set_cell_id.Rd deleted file mode 100644 index 038c8cea..00000000 --- a/man/set_cell_id.Rd +++ /dev/null @@ -1,82 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_cell_id} -\alias{set_cell_id} -\title{Set cell IDs for a given spatial unit} -\usage{ -set_cell_id( - gobject, - spat_unit = NULL, - cell_IDs, - set_defaults = TRUE, - verbose = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{cell_IDs}{character vector of cell IDs to set. (See details)} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{verbose}{be verbose} -} -\value{ -giotto object with set cell_ID slot -} -\description{ -Setter function for the cell_ID slot. Directly replaces (sets) -this slot -} -\details{ -Data for each spatial unit is expected to agree on a single set of cell_IDs -that are shared across any feature types. These cell_IDs are stored within -the giotto object's \code{cell_ID} slot. \cr - -Pass \code{NULL} to \code{cell_IDs} param in order to delete the entry. \cr -Pass \code{'initialize'} to \code{cell_IDs} param in order to initialize the -specified entry. \cr - -\strong{NOTE:} The main purpose of the setter is to initialize, as cell_ID -values are AUTOMATICALLY updated every time \code{initialize()} is called -on the giotto object. -} -\seealso{ -get_cell_id - -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{functions to set data in giotto object} -\keyword{internal} diff --git a/man/set_cell_metadata.Rd b/man/set_cell_metadata.Rd deleted file mode 100644 index b880a567..00000000 --- a/man/set_cell_metadata.Rd +++ /dev/null @@ -1,78 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_cell_metadata} -\alias{set_cell_metadata} -\title{Set cell metadata} -\usage{ -set_cell_metadata( - gobject, - metadata, - spat_unit = NULL, - feat_type = NULL, - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{metadata}{cellMetaObj or data.table containing cell metadata. -Setting NULL will remove the object. Passing 'initialize' will reset -the object.} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{provenance}{provenance information to set} - -\item{verbose}{be verbose} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{initialize}{(default = FALSE) whether to initialize the gobject before -returning} -} -\value{ -giotto object -} -\description{ -Function to set cell metadata information into giotto object -} -\seealso{ -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{functions to set data in giotto object} -\keyword{internal} diff --git a/man/set_dimReduction.Rd b/man/set_dimReduction.Rd deleted file mode 100644 index 4b3df227..00000000 --- a/man/set_dimReduction.Rd +++ /dev/null @@ -1,90 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_dimReduction} -\alias{set_dimReduction} -\title{Set dimension reduction} -\usage{ -set_dimReduction( - gobject, - dimObject, - spat_unit = NULL, - feat_type = NULL, - reduction = c("cells", "feats"), - reduction_method = c("pca", "umap", "tsne"), - name = "pca", - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{dimObject}{dimension object result to set} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{reduction}{reduction on cells or features} - -\item{reduction_method}{reduction method (e.g. "pca")} - -\item{name}{name of reduction results} - -\item{provenance}{provenance information (optional)} - -\item{verbose}{be verbose} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{initialize}{(default = FALSE) whether to initialize the gobject before -returning} -} -\value{ -giotto object -} -\description{ -Function to set a dimension reduction slot -} -\seealso{ -Other dimensional reduction data accessor functions: -\code{\link{getDimReduction}()}, -\code{\link{get_dimReduction}()}, -\code{\link{setDimReduction}()} - -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{dimensional reduction data accessor functions} -\concept{functions to set data in giotto object} diff --git a/man/set_expression_values.Rd b/man/set_expression_values.Rd deleted file mode 100644 index 11bd9ce7..00000000 --- a/man/set_expression_values.Rd +++ /dev/null @@ -1,83 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_expression_values} -\alias{set_expression_values} -\title{Set expression values} -\usage{ -set_expression_values( - gobject, - values, - spat_unit = NULL, - feat_type = NULL, - name = "test", - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{values}{exprObj If NULL, then the object will be removed.} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{name}{name for the expression slot} - -\item{provenance}{provenance information (optional)} - -\item{verbose}{be verbose} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{initialize}{(default = FALSE) whether to initialize the gobject before -returning. Will be set to TRUE when called by the external} -} -\value{ -giotto object -} -\description{ -Function to set expression values for giotto object -} -\seealso{ -Other expression accessor functions: -\code{\link{getExpression}()}, -\code{\link{setExpression}()} - -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{expression accessor functions} -\concept{functions to set data in giotto object} diff --git a/man/set_feat_id.Rd b/man/set_feat_id.Rd deleted file mode 100644 index b5a49ff0..00000000 --- a/man/set_feat_id.Rd +++ /dev/null @@ -1,83 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_feat_id} -\alias{set_feat_id} -\title{Set feat IDs for a given feature type} -\usage{ -set_feat_id( - gobject, - feat_type = NULL, - feat_IDs, - set_defaults = TRUE, - verbose = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{feat_IDs}{character vector of feature IDs to set.} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{verbose}{be verbose} -} -\value{ -giotto object with set cell_ID slot -} -\description{ -Setter function for the feat_ID slot. Directly replaces (sets) -this slot -} -\details{ -Across a single modality/feature type, and within a spatial unit, all feature -information is expected to share a single set of feat_IDs. These feat_IDs -are stored within the giotto object's \code{feat_ID} slot separated by -feat_type. \cr - -Pass \code{NULL} to \code{feat_IDs} param in order to delete the entry. \cr -Pass \code{'initialize'} to \code{feat_IDs} param in order to initialize the -specified entry. \cr - -\strong{NOTE:} The main purpose of the setter is to initialize, as feat_ID -values are AUTOMATICALLY updated every time \code{initialize()} is called on -the giotto object. -} -\seealso{ -get_feat_id - -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{functions to set data in giotto object} -\keyword{internal} diff --git a/man/set_feature_info.Rd b/man/set_feature_info.Rd deleted file mode 100644 index 147c144e..00000000 --- a/man/set_feature_info.Rd +++ /dev/null @@ -1,78 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_feature_info} -\alias{set_feature_info} -\title{Set feature info} -\usage{ -set_feature_info( - gobject, - gpoints, - feat_type = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE, - gpolygon = NULL -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{gpoints}{giotto points object} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{verbose}{be verbose} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{initialize}{(default = FALSE) whether to initialize the gobject before -returning} - -\item{gpolygon}{typo do not use} -} -\value{ -giotto object -} -\description{ -Set giotto polygon spatVector for features -} -\seealso{ -Other feature info data accessor functions: -\code{\link{getFeatureInfo}()}, -\code{\link{get_feature_info}()}, -\code{\link{setFeatureInfo}()} - -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{feature info data accessor functions} -\concept{functions to set data in giotto object} diff --git a/man/set_feature_metadata.Rd b/man/set_feature_metadata.Rd deleted file mode 100644 index d0c457ee..00000000 --- a/man/set_feature_metadata.Rd +++ /dev/null @@ -1,78 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_feature_metadata} -\alias{set_feature_metadata} -\title{Set feature metadata} -\usage{ -set_feature_metadata( - gobject, - metadata, - spat_unit = NULL, - feat_type = NULL, - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{metadata}{featMetaObj or data.table containing feature metadata. -Setting NULL will remove the object. Passing 'initialize' will reset the -object.} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{provenance}{provenance information to set} - -\item{verbose}{be verbose} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{initialize}{(default = FALSE) whether to initialize the gobject before -returning} -} -\value{ -giotto object -} -\description{ -Function to set feature metadata information into giotto object -} -\seealso{ -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{functions to set data in giotto object} -\keyword{internal} diff --git a/man/set_giottoImage.Rd b/man/set_giottoImage.Rd deleted file mode 100644 index 6028d666..00000000 --- a/man/set_giottoImage.Rd +++ /dev/null @@ -1,81 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_giottoImage} -\alias{set_giottoImage} -\title{Set giotto image object} -\usage{ -set_giottoImage( - gobject = NULL, - image = NULL, - image_type = NULL, - name = NULL, - verbose = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{image}{giotto image object to be attached without modification to the -giotto object} - -\item{image_type}{deprecated} - -\item{name}{name of giotto image object} - -\item{verbose}{be verbose} -} -\value{ -giotto object -} -\description{ -Directly attach a giotto image to giotto object -} -\details{ -\emph{\strong{Use with care!}} This function directly attaches -giotto image objects to the gobject without further modifications of -spatial positioning values within the image object that are generally -needed in order for them to plot in the correct location relative to the -other modalities of spatial data. \cr For the more general-purpose method -of attaching image objects, see \code{\link{addGiottoImage}} -} -\seealso{ -\code{\link{addGiottoImage}} - -Other image data accessor functions: -\code{\link{getGiottoImage}()}, -\code{\link{get_giottoImage}()}, -\code{\link{setGiottoImage}()} - -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{functions to set data in giotto object} -\concept{image data accessor functions} diff --git a/man/set_giottoImage_MG.Rd b/man/set_giottoImage_MG.Rd deleted file mode 100644 index bf9cc1ad..00000000 --- a/man/set_giottoImage_MG.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_giottoImage_MG} -\alias{set_giottoImage_MG} -\title{Set \emph{magick}-based giotto \code{image}} -\usage{ -set_giottoImage_MG(gobject, image_object, name = NULL, verbose = NULL) -} -\arguments{ -\item{gobject}{giotto object} - -\item{image_object}{a giottoImage object} - -\item{name}{name to assign giottoImage} - -\item{verbose}{be verbose} -} -\value{ -giotto object -} -\description{ -Set a giottoImage for a giotto object with no additional -modifications -} -\keyword{internal} diff --git a/man/set_giottoLargeImage.Rd b/man/set_giottoLargeImage.Rd deleted file mode 100644 index b891509c..00000000 --- a/man/set_giottoLargeImage.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_giottoLargeImage} -\alias{set_giottoLargeImage} -\title{Set \emph{terra}-based giotto \code{largeImage}} -\usage{ -set_giottoLargeImage(gobject, largeImage_object, name = NULL, verbose = NULL) -} -\arguments{ -\item{gobject}{giotto object} - -\item{largeImage_object}{a giottoLargeImage object} - -\item{name}{name to assign giottoLargeImage} - -\item{verbose}{be verbose} -} -\value{ -giotto object -} -\description{ -Set a giottoLargeImage for a giotto object with no -additional modifications -} -\keyword{internal} diff --git a/man/set_multiomics.Rd b/man/set_multiomics.Rd index c08b14d1..3d3c04f4 100644 --- a/man/set_multiomics.Rd +++ b/man/set_multiomics.Rd @@ -51,13 +51,12 @@ Other multiomics accessor functions: \code{\link{setMultiomics}()} Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, \code{\link{setCellMetadata}()}, \code{\link{setDimReduction}()}, \code{\link{setExpression}()}, \code{\link{setFeatureInfo}()}, \code{\link{setFeatureMetadata}()}, +\code{\link{setGiotto}()}, \code{\link{setGiottoImage}()}, \code{\link{setMultiomics}()}, \code{\link{setNearestNetwork}()}, @@ -65,21 +64,7 @@ Other functions to set data in giotto object: \code{\link{setSpatialEnrichment}()}, \code{\link{setSpatialGrid}()}, \code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} +\code{\link{setSpatialNetwork}()} } \concept{functions to set data in giotto object} \concept{multiomics accessor functions} diff --git a/man/set_polygon_info.Rd b/man/set_polygon_info.Rd deleted file mode 100644 index 59a8cab5..00000000 --- a/man/set_polygon_info.Rd +++ /dev/null @@ -1,72 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_polygon_info} -\alias{set_polygon_info} -\title{Set polygon info} -\usage{ -set_polygon_info( - gobject, - gpolygon, - polygon_name = "cell", - verbose = TRUE, - initialize = FALSE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{gpolygon}{giottoPolygon object} - -\item{polygon_name}{name of polygons. Default -"cell" (only used when gpolygon is length of 1)} - -\item{verbose}{be verbose} - -\item{initialize}{(default = FALSE) whether to initialize the gobject before -returning} -} -\value{ -giotto object -} -\description{ -Set giotto polygon spatVector -} -\seealso{ -Other polygon info data accessor functions: -\code{\link{getPolygonInfo}()}, -\code{\link{get_polygon_info}()}, -\code{\link{setPolygonInfo}()} - -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{functions to set data in giotto object} -\concept{polygon info data accessor functions} diff --git a/man/set_spatialGrid.Rd b/man/set_spatialGrid.Rd deleted file mode 100644 index 76eba929..00000000 --- a/man/set_spatialGrid.Rd +++ /dev/null @@ -1,77 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_spatialGrid} -\alias{set_spatialGrid} -\title{Set spatial grid} -\usage{ -set_spatialGrid( - gobject, - spatial_grid, - spat_unit = NULL, - feat_type = NULL, - name = NULL, - verbose = TRUE, - set_defaults = TRUE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spatial_grid}{spatial grid object} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{name}{name of spatial grid} - -\item{verbose}{be verbose} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} -} -\value{ -giotto object -} -\description{ -Function to set a spatial grid -} -\seealso{ -Other spatial grid data accessor functions: -\code{\link{getSpatialGrid}()}, -\code{\link{get_spatialGrid}()}, -\code{\link{setSpatialGrid}()} - -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{functions to set data in giotto object} -\concept{spatial grid data accessor functions} diff --git a/man/set_spatialNetwork.Rd b/man/set_spatialNetwork.Rd deleted file mode 100644 index 5c420540..00000000 --- a/man/set_spatialNetwork.Rd +++ /dev/null @@ -1,81 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_spatialNetwork} -\alias{set_spatialNetwork} -\title{Set spatial network} -\usage{ -set_spatialNetwork( - gobject, - spatial_network, - spat_unit = NULL, - name = NULL, - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spatial_network}{spatial network} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{name}{name of spatial network} - -\item{provenance}{provenance name} - -\item{verbose}{be verbose} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{initialize}{(default = FALSE) whether to initialize the gobject before -returning} -} -\value{ -giotto object -} -\description{ -Function to set a spatial network -} -\seealso{ -Other spatial network data accessor functions: -\code{\link{getSpatialNetwork}()}, -\code{\link{get_spatialNetwork}()}, -\code{\link{setSpatialNetwork}()} - -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatial_enrichment}()}, -\code{\link{set_spatial_locations}()} -} -\concept{functions to set data in giotto object} -\concept{spatial network data accessor functions} diff --git a/man/set_spatial_enrichment.Rd b/man/set_spatial_enrichment.Rd deleted file mode 100644 index f00194fd..00000000 --- a/man/set_spatial_enrichment.Rd +++ /dev/null @@ -1,84 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_spatial_enrichment} -\alias{set_spatial_enrichment} -\title{Set spatial enrichment} -\usage{ -set_spatial_enrichment( - gobject, - spatenrichment, - spat_unit = NULL, - feat_type = NULL, - enrichm_name = "enrichment", - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spatenrichment}{spatial enrichment results} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} - -\item{enrichm_name}{name of spatial enrichment results. Default "DWLS"} - -\item{provenance}{provenance information (optional)} - -\item{verbose}{be verbose} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{initialize}{(default = FALSE) whether to initialize the gobject before -returning} -} -\value{ -giotto object -} -\description{ -Function to set a spatial enrichment slot -} -\seealso{ -Other spatial enrichment data accessor functions: -\code{\link{getSpatialEnrichment}()}, -\code{\link{get_spatial_enrichment}()}, -\code{\link{setSpatialEnrichment}()} - -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_locations}()} -} -\concept{functions to set data in giotto object} -\concept{spatial enrichment data accessor functions} diff --git a/man/set_spatial_locations.Rd b/man/set_spatial_locations.Rd deleted file mode 100644 index adbb5a14..00000000 --- a/man/set_spatial_locations.Rd +++ /dev/null @@ -1,93 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/slot_accessors.R -\name{set_spatial_locations} -\alias{set_spatial_locations} -\title{Set spatial locations} -\usage{ -set_spatial_locations( - gobject, - spatlocs, - spat_unit = NULL, - spat_loc_name = "raw", - provenance = NULL, - verbose = TRUE, - set_defaults = TRUE, - initialize = FALSE -) -} -\arguments{ -\item{gobject}{giotto object} - -\item{spatlocs}{spatial locations (accepts either \code{data.table} or -\code{spatLocsObj})} - -\item{spat_unit}{spatial unit (e.g. "cell")} - -\item{spat_loc_name}{name of spatial locations, default "raw"} - -\item{provenance}{provenance information (optional)} - -\item{verbose}{be verbose} - -\item{set_defaults}{set default spat_unit and feat_type. Change to FALSE only when -expression and spat_info are not expected to exist.} - -\item{initialize}{(default = FALSE) whether to initialize the gobject before -returning} -} -\value{ -giotto object -} -\description{ -Function to set a spatial location slot -} -\details{ -If a \code{spatLocsObj} is provided to \code{spatlocs} param then -any attached name and spat_unit info will be used for input to this -function's \code{spat_loc_name} and \code{spat_unit}params, BUT will be -overridden by any alternative specific inputs to those params. \cr -ie: a \code{spatLocsObj} with spat_unit slot == 'cell' will be automatically -nested by spat_unit 'cell' when using \code{set_spatial_locations} as long as -param \code{spat_unit = NULL}. BUT if param \code{spat_unit = 'nucleus'} then -the \code{spatLocsObj} will be nested by spat_unit 'nucleus' instead and -its spat_unit slot will be changed to 'nucleus' -} -\seealso{ -Other spatial location data accessor functions: -\code{\link{getSpatialLocations}()}, -\code{\link{get_spatial_locations}()}, -\code{\link{setSpatialLocations}()} - -Other functions to set data in giotto object: -\code{\link{get_cell_id}()}, -\code{\link{get_feat_id}()}, -\code{\link{setCellMetadata}()}, -\code{\link{setDimReduction}()}, -\code{\link{setExpression}()}, -\code{\link{setFeatureInfo}()}, -\code{\link{setFeatureMetadata}()}, -\code{\link{setGiottoImage}()}, -\code{\link{setMultiomics}()}, -\code{\link{setNearestNetwork}()}, -\code{\link{setPolygonInfo}()}, -\code{\link{setSpatialEnrichment}()}, -\code{\link{setSpatialGrid}()}, -\code{\link{setSpatialLocations}()}, -\code{\link{setSpatialNetwork}()}, -\code{\link{set_NearestNetwork}()}, -\code{\link{set_cell_id}()}, -\code{\link{set_cell_metadata}()}, -\code{\link{set_dimReduction}()}, -\code{\link{set_expression_values}()}, -\code{\link{set_feat_id}()}, -\code{\link{set_feature_info}()}, -\code{\link{set_feature_metadata}()}, -\code{\link{set_giottoImage}()}, -\code{\link{set_multiomics}()}, -\code{\link{set_polygon_info}()}, -\code{\link{set_spatialGrid}()}, -\code{\link{set_spatialNetwork}()}, -\code{\link{set_spatial_enrichment}()} -} -\concept{functions to set data in giotto object} -\concept{spatial location data accessor functions} diff --git a/man/settleGeom.Rd b/man/settleGeom.Rd new file mode 100644 index 00000000..fdf497ed --- /dev/null +++ b/man/settleGeom.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/buffer.R +\name{settleGeom} +\alias{settleGeom} +\alias{settleGeom,giottoPolygon-method} +\alias{settleGeom,SpatVector-method} +\title{Settle polygon bounds} +\usage{ +\S4method{settleGeom}{giottoPolygon}(x) + +\S4method{settleGeom}{SpatVector}(x) +} +\arguments{ +\item{x}{a \code{SpatVector} of type "polygons" or object inheriting from +\code{giottoPolygon}} +} +\value{ +same class as \code{x}, with the contained polygons borders settled +in relation to each other. +} +\description{ +Settle the boundaries between polygons when they overlap by +splitting both at the point where they touch. Works through intersection +with the voronoi of the centroids. +} +\examples{ +svp <- GiottoData::loadSubObjectMini("giottoPolygon")[] +svp <- buffer(svp, 5) +plot(svp) +svp <- settleGeom(svp) +plot(svp) +} diff --git a/man/show.Rd b/man/show.Rd index f32bad5f..2d8bfeab 100644 --- a/man/show.Rd +++ b/man/show.Rd @@ -61,6 +61,9 @@ \arguments{ \item{object}{object to show} } +\value{ +giotto slot +} \description{ Show methods for Giotto classes } diff --git a/man/sliceGiotto.Rd b/man/sliceGiotto.Rd new file mode 100644 index 00000000..85ce2da1 --- /dev/null +++ b/man/sliceGiotto.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/methods-extract.R +\name{sliceGiotto} +\alias{sliceGiotto} +\title{Slice \code{giotto} object by \code{spat_unit} and \code{feat_type}} +\usage{ +sliceGiotto(gobject, spat_unit = ":all:", feat_type = ":all:", verbose = FALSE) +} +\arguments{ +\item{gobject}{\code{giotto} object} + +\item{spat_unit}{character vector. Spatial units to slice out. ":all:" +means keeping all of them in the output} + +\item{feat_type}{character vector. Feature types to slice out. ":all:" +means keeping all of them in the output} + +\item{verbose}{be verbose} +} +\value{ +\code{giotto} object +} +\description{ +Extract specific spatial units and feature types from a +\code{giotto} object as independent \code{giotto} objects. +} +\examples{ +g <- GiottoData::loadGiottoMini("vizgen") +res <- sliceGiotto(g, spat_unit = "aggregate") +force(res) +} +\seealso{ +\code{\link[=subsetGiotto]{subsetGiotto()}} \link{subset_giotto} +} diff --git a/man/spatIDs-generic.Rd b/man/spatIDs-generic.Rd index 3fb6b4c7..8e931fd8 100644 --- a/man/spatIDs-generic.Rd +++ b/man/spatIDs-generic.Rd @@ -20,7 +20,7 @@ \alias{featIDs,spatEnrObj-method} \title{Spatial and feature IDs} \usage{ -\S4method{spatIDs}{giotto}(x, spat_unit = NULL, ...) +\S4method{spatIDs}{giotto}(x, spat_unit = NULL, subset, negate = FALSE, quote = TRUE, ...) \S4method{spatIDs}{exprObj}(x, ...) @@ -38,7 +38,7 @@ \S4method{spatIDs}{nnNetObj}(x, ...) -\S4method{featIDs}{giotto}(x, feat_type = NULL, ...) +\S4method{featIDs}{giotto}(x, feat_type = NULL, subset, negate = FALSE, quote = TRUE, ...) \S4method{featIDs}{exprObj}(x, ...) @@ -53,7 +53,19 @@ \item{spat_unit}{(optional) specify which spatial unit} -\item{...}{additional parameters to pass} +\item{subset}{logical expression to find a subset of features.} + +\item{negate}{logical. if \code{TRUE} all IDs that are \strong{not} in the \code{subset} +are selected} + +\item{quote}{logical. If \code{TRUE}, the \code{subset} param will be quoted with +\code{substitute()}. Set this to \code{FALSE} when calling from a function, although +that may not be recommended since NSE output can be unexpected when not used +interactively.} + +\item{\dots}{additional params to pass when used with the \code{subset} param. +For \code{spatID()}, these pass to \code{\link[=spatValues]{spatValues()}}. For \code{featID()}, these +currently only pass to \code{fDataDT()}.} \item{use_cache}{use cached IDs if available (gpoly and gpoints only)} @@ -63,7 +75,7 @@ only (currently gpoly and gpoints only)} \item{feat_type}{(optional) specify which feature type} } \value{ -spatIDs and featIDs +character vector of cell/spatial IDs or feature IDs } \description{ Get the cell @@ -85,7 +97,15 @@ expected IDs within all \code{giotto} slots, and not always the exact set or ordering. } \examples{ -g <- GiottoData::loadSubObjectMini("giottoPoints") +g <- GiottoData::loadGiottoMini("vis") +spatIDs(g) +spatIDs(g, subset = nr_feats <= 200) +spatIDs(g, subset = Dim.1 > 25, dim_reduction_to_use = "umap") featIDs(g) +featIDs(g, subset = nr_cells < 100) + +gpoints <- GiottoData::loadSubObjectMini("giottoPoints") +featIDs(gpoints) + } diff --git a/man/spatQueryGiottoPolygons.Rd b/man/spatQueryGiottoPolygons.Rd index c6c885d6..58f360ac 100644 --- a/man/spatQueryGiottoPolygons.Rd +++ b/man/spatQueryGiottoPolygons.Rd @@ -39,5 +39,5 @@ information recorded in the associated cell metadata. The final item in provided in param \code{filters} is the layer of information being queried. } \seealso{ -[spatQueryGiottoSpatLocs() +\code{\link[=relate]{relate()}} } diff --git a/man/spatUnit-generic.Rd b/man/spatUnit-generic.Rd index 79372945..178379de 100644 --- a/man/spatUnit-generic.Rd +++ b/man/spatUnit-generic.Rd @@ -4,13 +4,17 @@ \alias{spatUnit-generic} \alias{spatUnit} \alias{spatUnit<-} +\alias{spatUnit,ANY-method} \alias{spatUnit,list-method} \alias{spatUnit,spatData-method} \alias{spatUnit,giottoPolygon-method} \alias{spatUnit<-,spatData-method} \alias{spatUnit<-,giottoPolygon-method} +\alias{spatUnit<-,list-method} \title{Spatial unit information} \usage{ +\S4method{spatUnit}{ANY}(x) + \S4method{spatUnit}{list}(x) \S4method{spatUnit}{spatData}(x) @@ -20,6 +24,8 @@ \S4method{spatUnit}{spatData}(x) <- value \S4method{spatUnit}{giottoPolygon}(x) <- value + +\S4method{spatUnit}{list}(x) <- value } \arguments{ \item{x}{a Giotto S4 class subobject with spatial unit} @@ -34,6 +40,8 @@ access and set spat_unit slot of S4 subobject } \section{Functions}{ \itemize{ +\item \code{spatUnit(ANY)}: Get spatial unit information + \item \code{spatUnit(spatData)}: Get spatial unit information \item \code{spatUnit(giottoPolygon)}: Get spatial unit information diff --git a/man/spatValues.Rd b/man/spatValues.Rd index c3f2e525..e3c5822f 100644 --- a/man/spatValues.Rd +++ b/man/spatValues.Rd @@ -10,8 +10,11 @@ spatValues( feat_type = NULL, feats, expression_values = NULL, + spat_loc_name = NULL, spat_enr_name = NULL, poly_info = NULL, + dim_reduction_to_use = NULL, + dim_reduction_name = NULL, verbose = NULL, debug = FALSE ) @@ -29,11 +32,20 @@ the giotto object} \item{expression_values}{character. (optional) Name of expression information to use} +\item{spat_loc_name}{character. (optional) Name of spatial locations +information to use} + \item{spat_enr_name}{character. (optional) Name of spatial enrichments to use} \item{poly_info}{character. (optional) Name of polygons to use} +\item{dim_reduction_to_use}{character. (optional) Which type of dimension +reduction to use} + +\item{dim_reduction_name}{character. (optional) Name of dimension reduction +to use} + \item{verbose}{verbosity} \item{debug}{logical. (default = FALSE) See details.} @@ -43,7 +55,6 @@ A data.table with a cell_ID column and whichever feats were requested } \description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}}\cr Retrieve specific values from the \code{giotto} object for a specific \code{spat_unit} and \code{feat_type}. Values are returned as a data.table with the features requested and a \code{cell_ID} column. This function may be updated in the future @@ -55,13 +66,15 @@ slot it checks, see details. spatValues searches through the set of available information within the \code{giotto} object for matches to \code{feats}. The current search order is \enumerate{ -\item cell expression +\item{cell expression} \item{cell metadata} +\item{spatial locations} \item{spatial enrichment} +\item{dimension reduction} \item{polygon info} } If a specific name for one of the types of information is provided via a -param such as \code{expression_values}, \code{spat_enr_name}, \code{poly_info}, then +param such as \code{expression_values}, \code{spat_enr_name}, etc, then the search will only be performed on that type of data.\cr\cr \strong{[debug]}\cr This function uses Giotto's accessor functions which can usually throw errors diff --git a/man/spatial_binary_ops.Rd b/man/spatial_binary_ops.Rd new file mode 100644 index 00000000..21e3b3ca --- /dev/null +++ b/man/spatial_binary_ops.Rd @@ -0,0 +1,65 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/spatial_binary_ops.R +\name{spatial_binary_ops} +\alias{spatial_binary_ops} +\alias{snap} +\alias{erase} +\alias{symdif} +\alias{union} +\alias{intersect} +\alias{erase,spatialClasses,spatialClasses-method} +\alias{snap,giottoSpatial-method} +\alias{symdif,spatialClasses,spatialClasses-method} +\alias{union,spatialClasses,spatialClasses-method} +\alias{intersect,spatialClasses,spatialClasses-method} +\title{Spatial binary operations} +\usage{ +# S4 methods for giottoPolygon, giottoPoints, spatLocsObj, SpatVector # + +\S4method{erase}{spatialClasses,spatialClasses}(x, y, ...) + +\S4method{snap}{giottoSpatial}(x, y = NULL, tolerance, ...) + +\S4method{symdif}{spatialClasses,spatialClasses}(x, y, ...) + +\S4method{union}{spatialClasses,spatialClasses}(x, y) + +\S4method{intersect}{spatialClasses,spatialClasses}(x, y) +} +\arguments{ +\item{x}{spatial object 1} + +\item{y}{spatial object 2 (can be missing or NULL)} + +\item{...}{additional args to pass} + +\item{tolerance}{numeric. Snapping tolerance (distance between geometries)} +} +\value{ +The same class as \code{x} +} +\description{ +Perform geometric binary operations on Giotto spatial classes +(\code{giottoPolygon}, \code{giottoPoints} and \code{spatLocsObj}) and underlying +representations (only terra \code{SpatVector} right now.) +} +\examples{ +gpoly1 <- GiottoData::loadSubObjectMini("giottoPolygon") +epoly <- as.polygons(ext(c(6600, 6800, -5000, -4800))) +gpoly2 <- spatShift(gpoly1, dx = 20) + +plot(gpoly1) +plot(union(gpoly1, gpoly2)) +plot(erase(gpoly1, epoly)) + +plot(union(gpoly1, epoly)) + +plot(symdif(gpoly1, epoly)) + +plot(intersect(gpoly1, epoly)) + +if (FALSE) { + # takes a long time so don't run in checks + plot(snap(gpoly1, tolerance = 0.2)) +} +} diff --git a/man/splitGiotto.Rd b/man/splitGiotto.Rd new file mode 100644 index 00000000..43445295 --- /dev/null +++ b/man/splitGiotto.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/split.R +\name{splitGiotto} +\alias{splitGiotto} +\title{Split a Giotto Object} +\usage{ +splitGiotto(gobject, by, spat_unit = NULL, feat_type = NULL) +} +\arguments{ +\item{gobject}{giotto object to split} + +\item{by}{cell metadata column by which to split the object} + +\item{spat_unit}{character. Controls which spatial unit to pull splitting +information from. However, all spatial units will always be affected by the +split.} + +\item{feat_type}{character. Split affects these feature type(s). Default is +"rna"} +} +\value{ +\code{list} of \code{giotto} objects +} +\description{ +Split a Giotto object based on a cell metadata column into a list of multiple +Giotto objects. +} +\examples{ +g <- GiottoData::loadGiottoMini("visium") +splitGiotto(g, "leiden_clus") + +} diff --git a/man/subsetGiotto.Rd b/man/subsetGiotto.Rd index 5e980771..adcb8701 100644 --- a/man/subsetGiotto.Rd +++ b/man/subsetGiotto.Rd @@ -10,7 +10,7 @@ subsetGiotto( feat_type = "rna", cell_ids = NULL, feat_ids = NULL, - poly_info = NULL, + poly_info = spat_unit, all_spat_units = NULL, all_feat_types = NULL, spat_unit_fsub = ":all:", diff --git a/man/subset_bracket.Rd b/man/subset_bracket.Rd index f8c67477..96e96827 100644 --- a/man/subset_bracket.Rd +++ b/man/subset_bracket.Rd @@ -39,6 +39,8 @@ \alias{[,giottoPolygon,character,missing,missing-method} \alias{[,giottoPolygon,missing,gIndex,missing-method} \alias{[,terraVectData,gIndex,gIndex,missing-method} +\alias{[,giottoLargeImage,missing,missing,missing-method} +\alias{[,giottoImage,missing,missing,missing-method} \alias{[,affine2d,missing,missing,missing-method} \title{Subset part of an object with \code{[}} \usage{ @@ -116,6 +118,10 @@ \S4method{[}{terraVectData,gIndex,gIndex,missing}(x, i, j) +\S4method{[}{giottoLargeImage,missing,missing,missing}(x, i, j) + +\S4method{[}{giottoImage,missing,missing,missing}(x, i, j) + \S4method{[}{affine2d,missing,missing,missing}(x, i, j) } \arguments{ diff --git a/man/subset_dollar.Rd b/man/subset_dollar.Rd index 554a9bd4..ba52ebe0 100644 --- a/man/subset_dollar.Rd +++ b/man/subset_dollar.Rd @@ -3,6 +3,7 @@ \name{subset_dollar} \alias{subset_dollar} \alias{`$`} +\alias{$,giotto-method} \alias{$,coordDataDT-method} \alias{$,spatEnrObj-method} \alias{$,dimObj-method} @@ -11,6 +12,8 @@ \alias{$,affine2d-method} \title{Subset part of an object with \code{$}} \usage{ +\S4method{$}{giotto}(x, name) + \S4method{$}{coordDataDT}(x, name) \S4method{$}{spatEnrObj}(x, name) @@ -35,6 +38,11 @@ vector of values from a requested column \description{ Subset values from a Giotto Class using \code{$} operator. } +\section{Functions}{ +\itemize{ +\item \code{$}: Subset giotto object + +}} \section{\code{`$`} methods}{ diff --git a/man/subset_giotto.Rd b/man/subset_giotto.Rd new file mode 100644 index 00000000..8b136430 --- /dev/null +++ b/man/subset_giotto.Rd @@ -0,0 +1,91 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/methods-extract.R +\name{subset_giotto} +\alias{subset_giotto} +\alias{`[.giotto`} +\alias{[,giotto,gIndex,missing,missing-method} +\alias{[,giotto,missing,gIndex,missing-method} +\alias{[,giotto,gIndex,gIndex,missing-method} +\alias{[,giotto,missing,missing,missing-method} +\alias{subset,giotto-method} +\title{Subset a \code{giotto} object} +\usage{ +\S4method{[}{giotto,gIndex,missing,missing}(x, i, j, ..., drop = TRUE) + +\S4method{[}{giotto,missing,gIndex,missing}(x, i, j, ..., drop = TRUE) + +\S4method{[}{giotto,gIndex,gIndex,missing}(x, i, j, ..., drop = TRUE) + +\S4method{[}{giotto,missing,missing,missing}(x, i, j, ..., drop = TRUE) + +\S4method{subset}{giotto}( + x, + subset, + feat_ids = NULL, + cell_ids = NULL, + spat_unit = NULL, + feat_type = NULL, + negate = FALSE, + quote = TRUE, + ... +) +} +\arguments{ +\item{x}{a \code{giotto} object} + +\item{\dots}{additional params to pass to \code{spatValues} used with the +subset param} + +\item{drop}{not used} + +\item{subset}{Logical expression evaluated in expression values} + +\item{feat_ids, i}{character vector. Feature IDs to subset the object for.} + +\item{cell_ids, j}{character vector. Cell/spatial IDs to subset the object +for.} + +\item{spat_unit}{character. Controls which spatial unit to pull subsetting +information from when using \code{cell_ids}/\code{j} and \code{subset} params. However, +all spatial units will always be affected by the subset.} + +\item{feat_type}{character. Subset affects these feature type(s). Default +is \code{"rna"}} + +\item{negate}{logical. if \code{TRUE} all IDs that are \strong{not} in the \code{subset} +are selected} + +\item{quote}{logical. If \code{TRUE}, the \code{subset} param will be quoted with +\code{substitute()}. Set this to \code{FALSE} when calling from a function, although +that may not be recommended since NSE output can be unexpected when not used +interactively.} +} +\value{ +giotto object +} +\description{ +Subset a giotto object with \code{[} or \code{subset()} generic. The +implementation is different from \code{\link[=subsetGiotto]{subsetGiotto()}} in that all spatial units +will always be affected. The feature type to subset can be specified. +} +\section{Functions}{ +\itemize{ +\item \code{x[i}: Subset giotto objects + +}} +\examples{ +g <- GiottoData::loadGiottoMini("visium") + +# `[` examples +g[1:5] +g[, 2:10] +g[1:5, 2:10] +g[c(TRUE, FALSE), ] + +# subset() examples +subset(g, nr_feats > 300) +subset(g, nr_feats > 300, + cell_ids = c("GAATCGCCGGACACGG-1", "GAGGGCATCGCGTATC-1") +) +subset(g, Gfap + Gna12 > 10) +} diff --git a/man/subset_giotto_subobjects.Rd b/man/subset_giotto_subobjects.Rd new file mode 100644 index 00000000..2c489bd5 --- /dev/null +++ b/man/subset_giotto_subobjects.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/methods-extract.R +\name{subset_giotto_subobjects} +\alias{subset_giotto_subobjects} +\alias{`[[.giotto`} +\alias{[[,giotto,missing,missing-method} +\alias{[[,giotto,character,missing-method} +\alias{[[,giotto,missing,character-method} +\alias{[[,giotto,character,character-method} +\title{Subset \code{giotto} subobjects} +\usage{ +\S4method{[[}{giotto,missing,missing}(x, spat_unit = NULL, feat_type = NULL, drop = TRUE, ...) + +\S4method{[[}{giotto,character,missing}(x, i, spat_unit = NULL, feat_type = NULL, drop = TRUE, ...) + +\S4method{[[}{giotto,missing,character}(x, j, spat_unit = NULL, feat_type = NULL, drop = TRUE, ...) + +\S4method{[[}{giotto,character,character}(x, i, j, spat_unit = NULL, feat_type = NULL, drop = TRUE, ...) +} +\arguments{ +\item{x}{giotto object} + +\item{spat_unit}{spatial unit (e.g. "cell")} + +\item{feat_type}{feature type to use (e.g. "rna", "protein")} + +\item{drop}{logical. Default = TRUE} + +\item{\dots}{additional arguments} + +\item{i}{character. Indicates the slot name} + +\item{j}{character. Indicates the subobject name} +} +\value{ +giotto subobject +} +\description{ +Subset a \code{giotto} object with \code{[[} to disassemble it into a list of Giotto +S4 subobjects. If \code{drop} is \code{FALSE}, the selected subobjects +will be reassembled into a new \code{giotto} object. Note that indexing within +the \code{[[} filters for only those subobjects that have those attributes. +This may remove some unexpected information. For specifically splitting the +\code{giotto} object by spatial unit and/or feature type while keeping all +expected information, use \code{\link[=sliceGiotto]{sliceGiotto()}} +} +\examples{ +g <- GiottoData::loadGiottoMini("vizgen") +force(g) + +# return as lists of subobjects with drop = TRUE (default) +g[[, "raw"]] +g[["expression", spat_unit = "aggregate"]] + +# return as a subset giotto object with drop = FALSE +g[[, "raw", drop = FALSE]] +g[[spat_unit = "aggregate", drop = FALSE]] +} diff --git a/man/update_giotto_params.Rd b/man/update_giotto_params.Rd index 9e607bf1..d757a958 100644 --- a/man/update_giotto_params.Rd +++ b/man/update_giotto_params.Rd @@ -19,7 +19,7 @@ update_giotto_params( \item{return_gobject}{logical. Whether the giotto object should be returned} \item{toplevel}{expected relative stackframe where call that is being -recorded was made} +recorded was made. If negative, param recording is skipped} } \value{ giotto object or list of parameters diff --git a/tests/testthat/test-GiottoInstructions.R b/tests/testthat/test-GiottoInstructions.R index 8c9bf152..a74a56ed 100644 --- a/tests/testthat/test-GiottoInstructions.R +++ b/tests/testthat/test-GiottoInstructions.R @@ -41,35 +41,32 @@ test_that("Instructions are created", { expect_type(instrs, "list") }) -# readGiottoInstructions -test_that("readGiottoInstructions reads a few giotto object params correctly", { - expect_type(readGiottoInstructions(gobject, param = "show_plot"), "logical") - expect_type(readGiottoInstructions(gobject, param = "plot_format"), "character") - expect_type(readGiottoInstructions(gobject, param = "dpi"), "double") +# read GiottoInstructions +test_that("instructions reads a few giotto object params correctly", { + expect_type(instructions(gobject, param = "show_plot"), "logical") + expect_type(instructions(gobject, param = "plot_format"), "character") + expect_type(instructions(gobject, param = "dpi"), "double") }) -# showGiottoInstructions -test_that("showGiottoInstructions returns expected list", { - expect_type(showGiottoInstructions(gobject), "list") +# show GiottoInstructions +test_that("instructions returns expected list", { + expect_type(instructions(gobject), "list") }) -# changeGiottoInstructions -gobject <- changeGiottoInstructions( - gobject, - params = c("show_plot", "save_plot"), - new_values = c(FALSE, TRUE), - return_gobject = TRUE -) +# change GiottoInstructions +instructions(gobject, + param = c("show_plot", "save_plot") +) <- list(FALSE, TRUE) -test_that("changeGiottoInstructions changes instruction params in object", { - expect_false(readGiottoInstructions(gobject, param = "show_plot")) - expect_true(readGiottoInstructions(gobject, param = "save_plot")) +test_that("change GiottoInstructions changes instruction params in object", { + expect_false(instructions(gobject, param = "show_plot")) + expect_true(instructions(gobject, param = "save_plot")) }) -# replaceGiottoInstructions -gobject <- replaceGiottoInstructions(gobject, instrs) +# replace GiottoInstructions +instructions(gobject) <- instrs -test_that("replaceGiottoInstructions returns object instructions to original", { - expect_true(readGiottoInstructions(gobject, param = "show_plot")) - expect_false(readGiottoInstructions(gobject, param = "save_plot")) +test_that("instructions returns object instructions to original", { + expect_true(instructions(gobject, param = "show_plot")) + expect_false(instructions(gobject, param = "save_plot")) }) diff --git a/tests/testthat/test-auxiliary.R b/tests/testthat/test-auxiliary.R index 271c3b01..ec7963e6 100644 --- a/tests/testthat/test-auxiliary.R +++ b/tests/testthat/test-auxiliary.R @@ -1,11 +1,11 @@ - # dummy gobject options("giotto.use_conda" = FALSE) g <- suppressWarnings(giotto()) # hide no python warning # dummy expression m <- matrix( - seq(9), ncol = 3, + seq(9), + ncol = 3, dimnames = list( sprintf("gene_%s", letters[seq(3)]), sprintf("cell_%d", seq(3)) @@ -41,21 +41,25 @@ test_that("createMetafeat can calculate mean values", { expect_m <- matrix(rep(c(2, 5, 8), 3), nrow = 3) g <- createMetafeats( - g, stat = "mean", + g, + stat = "mean", expression_values = "test", feat_clusters = num_vec_clus, name = "chara_vec_mean", verbose = FALSE ) - enr <- getSpatialEnrichment(g, name = "chara_vec_mean", - output = "data.table") + enr <- getSpatialEnrichment(g, + name = "chara_vec_mean", + output = "data.table" + ) test_m_num <- as.matrix(enr[, 1:3]) dimnames(test_m_num) <- NULL expect_identical(test_m_num, expect_m) g <- createMetafeats( - g, stat = "mean", + g, + stat = "mean", expression_values = "test", feat_clusters = df_clus, name = "df_mean", @@ -73,7 +77,8 @@ test_that("createMetafeat can calculate sum values", { expect_m <- matrix(c(6, 15, 24, 4, 10, 16, 2, 5, 8), nrow = 3) g <- createMetafeats( - g, stat = "sum", + g, + stat = "sum", expression_values = "test", feat_clusters = num_vec_clus, name = "sum", @@ -91,7 +96,8 @@ test_that("createMetafeat can calculate min values", { expect_m <- matrix(c(1L, 4L, 7L, 1L, 4L, 7L, 2L, 5L, 8L), nrow = 3) g <- createMetafeats( - g, stat = "min", + g, + stat = "min", expression_values = "test", feat_clusters = num_vec_clus, name = "min", @@ -109,7 +115,8 @@ test_that("createMetafeat can calculate max values", { expect_m <- matrix(c(3L, 6L, 9L, 3L, 6L, 9L, 2L, 5L, 8L), nrow = 3) g <- createMetafeats( - g, stat = "max", + g, + stat = "max", expression_values = "test", feat_clusters = num_vec_clus, name = "max", @@ -127,14 +134,17 @@ test_that("createMetafeat can use weights", { expect_m <- matrix(c(4, 10, 16, 0.4, 1.3, 2.2, 2, 5, 8), nrow = 3) g <- createMetafeats( - g, stat = "mean", + g, + stat = "mean", expression_values = "test", feat_clusters = df_clus_weight, name = "weighted_means", verbose = FALSE ) - enr <- getSpatialEnrichment(g, name = "weighted_means", - output = "data.table") + enr <- getSpatialEnrichment(g, + name = "weighted_means", + output = "data.table" + ) test_m_num <- as.matrix(enr[, 1:3]) dimnames(test_m_num) <- NULL @@ -146,18 +156,20 @@ test_that("createMetafeat can use rescale", { expect_m <- matrix(rep(c(0, 0.5, 1), 3), nrow = 3) g <- createMetafeats( - g, stat = "mean", + g, + stat = "mean", expression_values = "test", feat_clusters = num_vec_clus, rescale_to = c(0, 1), name = "scaled_means", verbose = FALSE ) - enr <- getSpatialEnrichment(g, name = "scaled_means", - output = "data.table") + enr <- getSpatialEnrichment(g, + name = "scaled_means", + output = "data.table" + ) test_m_num <- as.matrix(enr[, 1:3]) dimnames(test_m_num) <- NULL expect_identical(test_m_num, expect_m) }) - diff --git a/tests/testthat/test-interoperability.R b/tests/testthat/test-interoperability.R new file mode 100644 index 00000000..3858caaf --- /dev/null +++ b/tests/testthat/test-interoperability.R @@ -0,0 +1,71 @@ +library(testthat) +library(Seurat) + +giotto_obj <- GiottoData::loadGiottoMini("visium") +seurat_obj <- giottoToSeuratV5(giotto_obj) +spe_obj <- giottoToSpatialExperiment(giotto_obj) + +giotto_obj_roundtrip <- seuratToGiottoV5(seurat_obj, "rna") + +test_that("giottotoseurat function handles basic conversion", { + # Basic checks + expect_s4_class(seurat_obj, "Seurat") + expect_true(!is.null(seurat_obj@meta.data)) + expect_equal( + nrow(seurat_obj@meta.data), + nrow(giotto_obj@cell_metadata$cell$rna@metaDT) + ) + + # Check if image slots are handled correctly + if ("images" %in% slotNames(giotto_obj)) { + expect_true(length(seurat_obj@images) > 0) + expect_equal(length(seurat_obj@images), length(giotto_obj@images)) + expect_s4_class(giotto_obj_roundtrip@images$alignment, "giottoLargeImage") + expect_s4_class(seurat_obj@images$alignment, "VisiumV1") + } +}) + +test_that("Giotto to Seurat Conversion Works", { + expect_s4_class(seurat_obj, "Seurat") +}) + +test_that("Seurat to Giotto Conversion Works", { + expect_s4_class(giotto_obj, "giotto") +}) + +test_that("Assay names are converted correctly (no spaces)", { + # Check for spaces in Seurat assay names + assay_names <- names(seurat_obj@assays) + expect_false(any(grepl(" ", assay_names))) # No spaces should be present +}) + +test_that("Data is consistent after roundtrip conversion", { + identical(giotto_obj_roundtrip@expression, giotto_obj@expression) + # Check consistency of expression data + expect_equal( + dim(giotto_obj@expression$cell$rna$raw), + dim(giotto_obj_roundtrip@expression$cell$rna$raw) + ) + + # Check consistency of cell metadata + expect_equal( + nrow(giotto_obj@cell_metadata$cell$rna@metaDT), + nrow(giotto_obj_roundtrip@cell_metadata$cell$rna@metaDT) + ) +}) + +test_that("Feature metadata is transferred correctly", { + # Check if feature metadata (e.g., gene names) is correctly transferred + expect_equal( + rownames(seurat_obj@assays$rna), + rownames(giotto_obj@expression$cell$rna$raw) + ) +}) + +test_that("Giotto to SpatialExperiment Conversion Works", { + expect_s4_class(spe_obj[[1]], "SpatialExperiment") +}) + +# TODO +# spe +# annData diff --git a/tests/testthat/test-networks.R b/tests/testthat/test-networks.R index 100e4aed..560c37da 100644 --- a/tests/testthat/test-networks.R +++ b/tests/testthat/test-networks.R @@ -3,7 +3,7 @@ lifecycle_opt <- getOption("lifecycle_verbosity") options("lifecycle_verbosity" = "quiet") # ignore conda -options("giotto.has_conda" = FALSE) +options("giotto.use_conda" = FALSE) # load data to test diff --git a/tests/testthat/test-save_load.R b/tests/testthat/test-save_load.R index 79142a4e..eadb2ebb 100644 --- a/tests/testthat/test-save_load.R +++ b/tests/testthat/test-save_load.R @@ -17,3 +17,19 @@ test_that("gobject an be ovewritten and loaded - qs", { expect_true(methods::validObject(g3)) }) + +test_that("gobject can be saved and loaded - RDS", { + rlang::local_options(lifecycle_verbosity = "quiet") + saveGiotto(g, dir = test, overwrite = TRUE, verbose = FALSE) + g2 <<- loadGiotto(file.path(test, "saveGiottoDir")) + + expect_true(methods::validObject(g2)) +}) + +test_that("gobject an be ovewritten and loaded - RDS", { + rlang::local_options(lifecycle_verbosity = "quiet") + saveGiotto(g2, dir = test, overwrite = TRUE, verbose = FALSE) + g3 <- loadGiotto(file.path(test, "saveGiottoDir")) + + expect_true(methods::validObject(g3)) +}) diff --git a/tests/testthat/test-slot_accessors.R b/tests/testthat/test-slot_accessors.R index a44b1549..506555d5 100644 --- a/tests/testthat/test-slot_accessors.R +++ b/tests/testthat/test-slot_accessors.R @@ -20,7 +20,7 @@ test_that("Not found exprObj returns error", { expect_error( getExpression(giotto_object, spat_unit = "none", - feat_type = "none", + feat_type = "none", values = "raw" ) ) @@ -202,9 +202,12 @@ test_that("Finds NearestNetwork", { test_that("Finds PolygonInfo", { rlang::local_options(lifecycle_verbosity = "quiet") - expect_class(getPolygonInfo(giotto_object, - polygon_name = "z0"), - "SpatVector") + expect_class( + getPolygonInfo(giotto_object, + polygon_name = "z0" + ), + "SpatVector" + ) }) test_that("Finds SpatialEnrichment", { diff --git a/tests/testthat/test_join.R b/tests/testthat/test_join.R new file mode 100644 index 00000000..0774c69c --- /dev/null +++ b/tests/testthat/test_join.R @@ -0,0 +1,57 @@ +options("giotto.use_conda" = FALSE) +g <- GiottoData::loadGiottoMini("vis") +nobs <- nrow(pDataDT(g)) +nvar <- nrow(fDataDT(g)) + +test_that("visium can join", { + # remove to avoid warning about incorrect networks after spatloc edits + g@spatial_network <- NULL + + j <- joinGiottoObjects( + gobject_list = list(g, g, g), + gobject_names = letters[seq_len(3)] + ) + + checkmate::expect_class(j, "giotto") + expect_equal(nrow(pDataDT(j)), nobs * 3) + expect_equal(nrow(fDataDT(j)), nvar) + + # TODO check spatial +}) + +test_that("expression and spatloc join", { + gtest <- suppressWarnings(giotto()) + gtest <- setGiotto(gtest, getExpression(g), verbose = FALSE) + gtest <- setGiotto(gtest, getSpatialLocations(g), verbose = FALSE) + + j <- joinGiottoObjects( + gobject_list = list(gtest, gtest, gtest), + gobject_names = letters[seq_len(3)] + ) + + checkmate::expect_class(j, "giotto") + expect_equal(nrow(pDataDT(j)), nobs * 3) + expect_equal(nrow(fDataDT(j)), nvar) + + # TODO check spatial +}) + +# test_that("poly and spatloc join", { +# gtest <- suppressWarnings(giotto()) +# gtest <- setGiotto(gtest, getPolygonInfo(g, +# return_giottoPolygon = TRUE), +# verbose = FALSE +# ) +# gtest <- setGiotto(gtest, getSpatialLocations(g), verbose = FALSE) +# +# j <- joinGiottoObjects( +# gobject_list = list(gtest, gtest, gtest), +# gobject_names = letters[seq_len(3)] +# ) +# +# checkmate::expect_class(j, "giotto") +# expect_equal(nrow(pDataDT(j)), nobs * 3) +# expect_equal(nrow(fDataDT(j)), nvar) +# +# # TODO check spatial +# })