Merge pull request #21 from andyquinterom/T19

feat: Adds `get_roots` and `subset_graph` functions

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: orbweaver
 Title: Fast and Efficient Graph Data Structures
-Version: 0.2.1
+Version: 0.3.0
 Authors@R: 
     c(person(given = "ixpantia, SRL",
              role = "cph",

NAMESPACE

@@ -32,6 +32,8 @@ S3method(get_nodes,DirectedAcyclicGraph)
 S3method(get_nodes,DirectedGraph)
 S3method(get_parents,DirectedAcyclicGraph)
 S3method(get_parents,DirectedGraph)
+S3method(get_roots,DirectedAcyclicGraph)
+S3method(get_roots,DirectedGraph)
 S3method(graph_to_json,DirectedAcyclicGraph)
 S3method(graph_to_json,DirectedGraph)
 S3method(has_children,DirectedAcyclicGraph)
@@ -53,6 +55,8 @@ S3method(remove_edge,DirectedGraph)
 S3method(remove_node,DirectedAcyclicGraph)
 S3method(remove_node,DirectedGraph)
 S3method(set_node_data,Node)
+S3method(subset_graph,DirectedAcyclicGraph)
+S3method(subset_graph,DirectedGraph)
 export(add_edge)
 export(add_node)
 export(add_path)
@@ -67,6 +71,7 @@ export(get_node)
 export(get_node_data)
 export(get_nodes)
 export(get_parents)
+export(get_roots)
 export(graph_from_json)
 export(graph_to_json)
 export(has_children)
@@ -80,4 +85,5 @@ export(populate_nodes)
 export(remove_edge)
 export(remove_node)
 export(set_node_data)
+export(subset_graph)
 useDynLib(orbweaver, .registration = TRUE)

R/extendr-wrappers.R

@@ -77,6 +77,12 @@ DirectedGraph$get_leaves <- function() .Call(wrap__DirectedGraph__get_leaves, se
 
 DirectedGraph$get_leaves_under <- function(node_ids) .Call(wrap__DirectedGraph__get_leaves_under, self, node_ids)
 
+DirectedGraph$subset <- function(node_id) .Call(wrap__DirectedGraph__subset, self, node_id)
+
+DirectedGraph$get_roots <- function() .Call(wrap__DirectedGraph__get_roots, self)
+
+DirectedGraph$get_roots_over <- function(node_ids) .Call(wrap__DirectedGraph__get_roots_over, self, node_ids)
+
 DirectedGraph$clear_edges <- function() invisible(.Call(wrap__DirectedGraph__clear_edges, self))
 
 DirectedGraph$into_dag <- function() .Call(wrap__DirectedGraph__into_dag, self)
@@ -119,6 +125,12 @@ DirectedAcyclicGraph$get_leaves <- function() .Call(wrap__DirectedAcyclicGraph__
 
 DirectedAcyclicGraph$get_leaves_under <- function(node_ids) .Call(wrap__DirectedAcyclicGraph__get_leaves_under, self, node_ids)
 
+DirectedAcyclicGraph$subset <- function(node_id) .Call(wrap__DirectedAcyclicGraph__subset, self, node_id)
+
+DirectedAcyclicGraph$get_roots <- function() .Call(wrap__DirectedAcyclicGraph__get_roots, self)
+
+DirectedAcyclicGraph$get_roots_over <- function(node_ids) .Call(wrap__DirectedAcyclicGraph__get_roots_over, self, node_ids)
+
 DirectedAcyclicGraph$into_directed <- function() .Call(wrap__DirectedAcyclicGraph__into_directed, self)
 
 #' @export

R/get_leaves.R

@@ -1,4 +1,4 @@
-#' @title Get the leave node of a graph
+#' @title Get the leave nodes of a graph
 #'
 #' @description
 #' Retrieves the nodes in a graph that have no children.

R/get_roots.R

@@ -0,0 +1,30 @@
+#' @title Get the root nodes of a graph
+#'
+#' @description
+#' Retrieves the nodes in a graph that have no parents
+#'
+#' If no `node_ids` argument is supplied then all of
+#' the roots in the graph are returned.
+#' @param graph A graph object
+#' @param node_ids The node ids of which the roots must be descendants of
+#' @return A character vector of node ids
+#' @export
+get_roots <- function(graph, node_ids) {
+  UseMethod("get_roots")
+}
+
+#' @export
+get_roots.DirectedGraph <- function(graph, node_ids) {
+  if (missing(node_ids)) {
+    return(graph$get_roots())
+  }
+  graph$get_roots_over(node_ids)
+}
+
+#' @export
+get_roots.DirectedAcyclicGraph <- function(graph, node_ids) {
+  if (missing(node_ids)) {
+    return(graph$get_roots())
+  }
+  graph$get_roots_over(node_ids)
+}

R/subset.R

@@ -0,0 +1,19 @@
+#' @title Get a subset or a graph
+#' @description todo!
+#' @param graph A graph object
+#' @param node_id The node id from which to split the tree
+#' @return A new graph object
+#' @export
+subset_graph <- function(graph, node_id) {
+  UseMethod("subset_graph")
+}
+
+#' @export
+subset_graph.DirectedGraph <- function(graph, node_id) {
+  graph$subset(node_id)
+}
+
+#' @export
+subset_graph.DirectedAcyclicGraph <- function(graph, node_id) {
+  graph$subset(node_id)
+}

src/rust/Cargo.toml

@@ -9,5 +9,5 @@ name = 'orbweaver'
 
 [dependencies]
 extendr-api = { version = "0.6", features = ["serde"] }
-orbweaver = { version = "0.2.1" }
+orbweaver = { version = "0.3.0" }
 serde_json = "1.0.117"

src/rust/src/lib.rs

@@ -162,6 +162,26 @@ impl DirectedGraph {
             .collect())
     }
 
+    pub fn subset(&self, node_id: &str) -> Result<DirectedGraph> {
+        Ok(DirectedGraph(
+            self.0.subset(node_id).map_err(to_r_error)?.cloned(),
+        ))
+    }
+
+    pub fn get_roots(&self) -> Vec<String> {
+        self.0.get_roots().into_iter().map(String::from).collect()
+    }
+
+    pub fn get_roots_over(&self, node_ids: Vec<String>) -> Result<Vec<String>> {
+        Ok(self
+            .0
+            .get_roots_over(&node_ids)
+            .map_err(to_r_error)?
+            .into_iter()
+            .map(String::from)
+            .collect())
+    }
+
     pub fn clear_edges(&mut self) {
         self.0.clear_edges();
     }
@@ -277,6 +297,26 @@ impl DirectedAcyclicGraph {
             .collect())
     }
 
+    pub fn subset(&self, node_id: &str) -> Result<DirectedAcyclicGraph> {
+        Ok(DirectedAcyclicGraph(
+            self.0.subset(node_id).map_err(to_r_error)?.cloned(),
+        ))
+    }
+
+    pub fn get_roots(&self) -> Vec<String> {
+        self.0.get_roots().into_iter().map(String::from).collect()
+    }
+
+    pub fn get_roots_over(&self, node_ids: Vec<String>) -> Result<Vec<String>> {
+        Ok(self
+            .0
+            .get_roots_over(&node_ids)
+            .map_err(to_r_error)?
+            .into_iter()
+            .map(String::from)
+            .collect())
+    }
+
     #[allow(clippy::wrong_self_convention)]
     pub fn into_directed(&self) -> DirectedGraph {
         DirectedGraph(self.0.clone().into_inner())

tests/testthat/test-subset.R

@@ -0,0 +1,45 @@
+test_that("can find least common parents between selected nodes", {
+
+  graph <- new_directed_graph()
+
+  graph_edges <- data.frame(
+    parent = c("A", "B", "C", "C", "F"),
+    child = c("B", "C", "D", "E", "D")
+  )
+
+  graph_nodes <- data.frame(
+    node_id = c("A", "B", "C", "D", "E", "F")
+  )
+
+  graph |>
+    populate_nodes(graph_nodes, "node_id") |>
+    populate_edges(graph_edges, "parent", "child")
+
+
+  graph_under_d <- graph |>
+    subset_graph("D")
+
+  nodes <- graph_under_d |>
+    get_nodes()
+
+  expect_equal(length(nodes), 1)
+
+  graph_under_c <- graph |>
+    subset_graph("C")
+
+  nodes <- graph_under_c |>
+    get_nodes()
+
+  expect_equal(length(nodes), 3)
+  expect_equal(find_path(graph_under_c, "C", "E"), c("C", "E"))
+
+  graph_under_b <- graph |>
+    subset_graph("B")
+
+  nodes <- graph_under_b |>
+    get_nodes()
+
+  expect_equal(length(nodes), 4)
+  expect_equal(find_path(graph_under_b, "B", "E"), c("B", "C", "E"))
+
+})