Skip to content

Commit

Permalink
try hash tables for graph and graph
Browse files Browse the repository at this point in the history
  • Loading branch information
@wlandau
wlandau committed Jan 10, 2025
1 parent d351ddf commit e381745
Show file tree
Hide file tree
Showing 4 changed files with 77 additions and 52 deletions.
73 changes: 47 additions & 26 deletions R/class_graph.R
View file
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
graph_init <- function(edges = NULL) {
edges <- edges %|||% data_frame(from = character(0), to = character(0))
upstream <- adjacency_list(edges$from, edges$to)
downstream <- adjacency_list(edges$to, edges$from)
upstream <- lookup_init(adjacency_list(from = edges$from, to = edges$to))
downstream <- lookup_init(adjacency_list(from = edges$to, to = edges$from))
graph_new(upstream, downstream)
}

Expand All @@ -24,13 +24,25 @@ graph_class <- R6::R6Class(
self$upstream <- upstream
self$downstream <- downstream
},
produce_degrees = function(names, mode) {
list <- if_any(
identical(mode, "upstream"),
self$upstream,
self$downstream
)
unname(map_int(list[names], length))
produce_degrees_upstream = function(names) {
index <- 1L
n <- length(names)
out <- vector(mode = "integer", length = n)
while (index <= n) {
out[index] <- length(.subset2(upstream, .subset(names, index)))
index <- index + 1L
}
out
},
produce_degrees_downstream = function(names) {
index <- 1L
n <- length(names)
out <- vector(mode = "integer", length = n)
while (index <= n) {
out[index] <- length(.subset2(downstream, .subset(names, index)))
index <- index + 1L
}
out
},
produce_upstream = function(name) {
as.character(.subset2(upstream, name))
Expand All @@ -39,16 +51,19 @@ graph_class <- R6::R6Class(
as.character(.subset2(downstream, name))
},
replace_upstream = function(name, from, to) {
upstream <- self$upstream
upstream[[name]][upstream[[name]] == from] <- to
self$upstream <- upstream
upstream[[name]][.subset2(upstream, name) == from] <- to
},
insert_edges = function(edges) {
upstream <- join_edges(self$upstream, edges$from, edges$to)
downstream <- join_edges(self$downstream, edges$to, edges$from)
self$upstream <- upstream
self$downstream <- downstream
invisible()
join_edges(
lookup = upstream,
from = .subset2(edges, "from"),
to = .subset2(edges, "to")
)
join_edges(
lookup = downstream,
from = .subset2(edges, "to"),
to = .subset2(edges, "from")
)
},
validate = function() {
lapply(self$upstream, tar_assert_chr)
Expand All @@ -59,18 +74,24 @@ graph_class <- R6::R6Class(
)

adjacency_list <- function(from, to) {
tapply(from, to, identity, simplify = FALSE)
tapply(X = from, INDEX = to, identity, simplify = FALSE)
}

join_edges <- function(edgelist, from, to) {
new_edgelist <- adjacency_list(from, to)
dups <- intersect(names(new_edgelist), names(edgelist))
new <- setdiff(names(new_edgelist), names(edgelist))
out <- c(edgelist, new_edgelist[new])
for (name in dups) {
out[[name]] <- union(out[[name]], new_edgelist[[name]])
join_edges <- function(lookup, from, to) {
new_edgelist <- adjacency_list(from = from, to = to)
index <- 1L
names <- names(new_edgelist)
n <- length(names)
while (index <= n) {
name <- .subset(names, index)
new_from <- .subset2(new_edgelist, index)
if (is.null(.subset2(lookup, name))) {
lookup[[name]] <- new_from
} else {
lookup[[name]] <- union(new_from, .subset2(lookup, name))
}
index <- index + 1L
}
out
}

remove_loops <- function(edges) {
Expand Down
4 changes: 4 additions & 0 deletions R/class_lookup.R
View file
Original file line number Diff line number Diff line change
@@ -1,3 +1,7 @@
lookup_init <- function(list, parent = emptyenv()) {
list2env(x = list, parent = parent, hash = TRUE)
}

lookup_new <- function(parent = emptyenv()) {
new.env(parent = parent, hash = TRUE)
}
Expand Down
2 changes: 1 addition & 1 deletion R/class_scheduler.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -40,7 +40,7 @@ scheduler_topo_sort <- function(igraph, priorities, queue) {
}

initial_ranks <- function(names, graph, priorities) {
graph$produce_degrees(names, "upstream") + rank_offset(priorities[names])
graph$produce_degrees_upstream(names) + rank_offset(priorities[names])
}

rank_offset <- function(priorities) {
Expand Down
50 changes: 25 additions & 25 deletions tests/testthat/test-class_graph.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,38 +32,38 @@ tar_test("graph$produce_downstream()", {
expect_equal(graph$produce_downstream("all"), character(0))
})

tar_test("graph$produce_degrees(mode = \"in\")", {
tar_test("graph$produce_degrees_upstream()", {
edges <- pipeline_upstream_edges(pipeline_order(), targets_only = TRUE)
graph <- graph_init(remove_loops(edges))
expect_equal(graph$produce_degrees("data1", mode = "upstream"), 0L)
expect_equal(graph$produce_degrees("data2", mode = "upstream"), 0L)
expect_equal(graph$produce_degrees("min1", mode = "upstream"), 1L)
expect_equal(graph$produce_degrees("min2", mode = "upstream"), 1L)
expect_equal(graph$produce_degrees("max1", mode = "upstream"), 1L)
expect_equal(graph$produce_degrees("max2", mode = "upstream"), 1L)
expect_equal(graph$produce_degrees("mins", mode = "upstream"), 2L)
expect_equal(graph$produce_degrees("maxes", mode = "upstream"), 2L)
expect_equal(graph$produce_degrees("all", mode = "upstream"), 2L)
expect_equal(graph$produce_degrees_upstream("data1"), 0L)
expect_equal(graph$produce_degrees_upstream("data2"), 0L)
expect_equal(graph$produce_degrees_upstream("min1"), 1L)
expect_equal(graph$produce_degrees_upstream("min2"), 1L)
expect_equal(graph$produce_degrees_upstream("max1"), 1L)
expect_equal(graph$produce_degrees_upstream("max2"), 1L)
expect_equal(graph$produce_degrees_upstream("mins"), 2L)
expect_equal(graph$produce_degrees_upstream("maxes"), 2L)
expect_equal(graph$produce_degrees_upstream("all"), 2L)
expect_equal(
graph$produce_degrees(c("all", "data1"), mode = "upstream"),
graph$produce_degrees_upstream(c("all", "data1")),
c(2L, 0L)
)
})

tar_test("graph$produce_degrees(mode = \"out\")", {
tar_test("graph$produce_degrees_downstream()", {
edges <- pipeline_upstream_edges(pipeline_order(), targets_only = TRUE)
graph <- graph_init(remove_loops(edges))
expect_equal(graph$produce_degrees("data1", mode = "out"), 2L)
expect_equal(graph$produce_degrees("data2", mode = "out"), 2L)
expect_equal(graph$produce_degrees("min1", mode = "out"), 1L)
expect_equal(graph$produce_degrees("min2", mode = "out"), 1L)
expect_equal(graph$produce_degrees("max1", mode = "out"), 1L)
expect_equal(graph$produce_degrees("max2", mode = "out"), 1L)
expect_equal(graph$produce_degrees("mins", mode = "out"), 1L)
expect_equal(graph$produce_degrees("maxes", mode = "out"), 1L)
expect_equal(graph$produce_degrees("all", mode = "out"), 0L)
expect_equal(graph$produce_degrees_downstream("data1"), 2L)
expect_equal(graph$produce_degrees_downstream("data2"), 2L)
expect_equal(graph$produce_degrees_downstream("min1"), 1L)
expect_equal(graph$produce_degrees_downstream("min2"), 1L)
expect_equal(graph$produce_degrees_downstream("max1"), 1L)
expect_equal(graph$produce_degrees_downstream("max2"), 1L)
expect_equal(graph$produce_degrees_downstream("mins"), 1L)
expect_equal(graph$produce_degrees_downstream("maxes"), 1L)
expect_equal(graph$produce_degrees_downstream("all"), 0L)
expect_equal(
graph$produce_degrees(c("all", "data1"), mode = "out"),
graph$produce_degrees_downstream(c("all", "data1")),
c(0L, 2L)
)
})
Expand All @@ -72,8 +72,8 @@ tar_test("graph$insert_edges() upstream checks", {
edges <- pipeline_upstream_edges(pipeline_order(), targets_only = TRUE)
graph <- graph_init(remove_loops(edges))
new_edgelist <- data_frame(
from = c("abc", "xyz", "min1", "other1"),
to = c("data1", "data2", "123", "other2")
from = c("abc", "xyz", "min1", "other1", "one_more"),
to = c("data1", "data2", "123", "other2", "all")
)
graph$insert_edges(new_edgelist)
upstream <- graph$upstream
Expand All @@ -90,7 +90,7 @@ tar_test("graph$insert_edges() upstream checks", {
expect_equal(upstream[["max2"]], "data2")
expect_equal(sort(upstream[["mins"]]), sort(c("min1", "min2")))
expect_equal(sort(upstream[["maxes"]]), sort(c("max1", "max2")))
expect_equal(sort(upstream[["all"]]), sort(c("mins", "maxes")))
expect_equal(sort(upstream[["all"]]), sort(c("mins", "maxes", "one_more")))
})

tar_test("graph$insert_edges() downstream checks", {
Expand Down

0 comments on commit e381745

Please sign in to comment.