diff --git a/R/spatial_clusters.R b/R/spatial_clusters.R index ca7fbd6cb..71bac9c94 100644 --- a/R/spatial_clusters.R +++ b/R/spatial_clusters.R @@ -42,13 +42,30 @@ #' Get which weakly connected set of vertices each vertex is part of #' @param g igraph #' @param clus_name character. name to assign column of clustering info +#' @param all_ids (optional) character vector with all ids +#' @param missing_id_name character and name for vertices that were missing from g #' @returns data.table #' @keywords internal -.igraph_vertex_membership <- function(g, clus_name) { - membership <- igraph::components(g)$membership %>% - data.table::as.data.table(keep.rownames = TRUE) - data.table::setnames(membership, c("cell_ID", clus_name)) - membership +.igraph_vertex_membership <- function(g, + clus_name, + all_ids = NULL, + missing_id_name) { + + # get membership + membership <- igraph::components(g)$membership %>% + data.table::as.data.table(keep.rownames = TRUE) + data.table::setnames(membership, c("cell_ID", clus_name)) + + # add vertices that were missing from g back + if(!is.null(all_ids)) { + missing_ids = all_ids[!all_ids %in% V(g)$name] + missing_membership = data.table::data.table('cell_ID' = missing_ids, 'cluster_name' = missing_id_name) + data.table::setnames(missing_membership, c("cell_ID", clus_name)) + membership = data.table::rbindlist(list(membership, missing_membership)) + } + + return(membership) + } @@ -62,8 +79,12 @@ #' @param cluster_col character. Column in metadata containing original #' clustering #' @param split_clus_name character. Name to assign the split cluster results -#' information to split -#' @returns cluster annotations +#' @param include_all_ids Boolean. Include all ids, including vertex ids not found +#' in the spatial network +#' @param missing_id_name Character. Name for vertices that were missing from +#' spatial network +#' @param return_gobject Boolean. Return giotto object +#' @returns giotto object with cluster annotations #' @examples #' library(Giotto) #' g <- GiottoData::loadGiottoMini("vizgen") @@ -83,7 +104,11 @@ spatialSplitCluster <- function( feat_type = NULL, spatial_network_name = "Delaunay_network", cluster_col, - split_clus_name = paste0(cluster_col, "_split")) { + split_clus_name = paste0(cluster_col, "_split"), + include_all_ids = TRUE, + missing_id_name = 'not_connected', + return_gobject = TRUE) { + # NSE vars cell_ID <- NULL @@ -132,18 +157,138 @@ spatialSplitCluster <- function( ) # get new clusterings - new_clus_dt <- .igraph_vertex_membership( + if(isTRUE(include_all_ids)) { + # include all cell IDs + all_ids = unique(cell_meta$cell_ID) + new_clus_dt <- .igraph_vertex_membership( g = g, - clus_name = split_clus_name - ) - - gobject <- addCellMetadata( + clus_name = split_clus_name, + all_ids = all_ids, + missing_id_name = missing_id_name + ) + } else { + # only IDs present in graph + new_clus_dt <- .igraph_vertex_membership( + g = g, + clus_name = split_clus_name, + all_ids = NULL + ) + + } + + if(isTRUE(return_gobject)) { + gobject <- addCellMetadata( gobject, spat_unit = spat_unit, new_metadata = new_clus_dt, by_column = TRUE, column_cell_ID = "cell_ID" - ) + ) + return(gobject) + } else { + new_clus_dt + } + +} + + - gobject + + +#' @title Split cluster annotations based on a spatial network +#' @name identifyTMAcores +#' @inheritParams data_access_params +#' @param spatial_network_name character. Name of spatial network to use +#' @param core_id_name metadata column name for the core information +#' @param include_all_ids Boolean. Include all ids, including vertex ids not found +#' in the spatial network +#' @param missing_id_name Character. Name for vertices that were missing from +#' spatial network +#' @param return_gobject Boolean. Return giotto object +#' @returns cluster annotations +#' @export +identifyTMAcores <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + spatial_network_name = "Delaunay_network", + core_id_name = 'core_id', + include_all_ids = TRUE, + missing_id_name = 'not_connected', + return_gobject = TRUE) { + + + # NSE vars + cell_ID <- NULL + + 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 + ) + + cell_meta <- getCellMetadata( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + output = "data.table", + copy_obj = FALSE + ) + + sn <- getSpatialNetwork( + gobject = gobject, + spat_unit = spat_unit, + name = spatial_network_name, + output = "spatialNetworkObj", + copy_obj = FALSE, + verbose = FALSE, + ) + + + g <- GiottoClass::spat_net_to_igraph(sn) + # convert spatialNetworkObject to igraph + + + # get new clusterings + if(isTRUE(include_all_ids)) { + # include all cell IDs + all_ids = unique(cell_meta$cell_ID) + new_clus_dt <- .igraph_vertex_membership( + g = g, + clus_name = core_id_name, + all_ids = all_ids, + missing_id_name = missing_id_name + ) + } else { + # only IDs present in graph + new_clus_dt <- .igraph_vertex_membership( + g = g, + clus_name = core_id_name, + all_ids = NULL + ) + + } + + if(isTRUE(return_gobject)) { + gobject <- addCellMetadata( + gobject, + spat_unit = spat_unit, + new_metadata = new_clus_dt, + by_column = TRUE, + column_cell_ID = "cell_ID" + ) + return(gobject) + } else { + new_clus_dt + } + + } + + + + +