function to split a graph and identify cores

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