The purpose of this document is to implement in R a Directed Acyclic Graph or Network that can evaluate arbitrary functions.
library(network)
##
## 'network' 1.17.2 (2022-05-20), part of the Statnet Project
## * 'news(package="network")' for changes since last version
## * 'citation("network")' for citation information
## * 'https://statnet.org' for help, support, and other information
Let’s create a Graph from a DataFrame
g_df <- data.frame(
from = c("a", "b", "c", "d", "e", "f", "g"),
to = c("c", "c", "e", "e", "h", "h", "h"),
stringsAsFactors = FALSE
)
g <- as.network(g_df)
And plot it.
plot.network(g,
label = network.vertex.names(g),
mode = "circle",
boxed.labels = TRUE
)
It is not documented, but a network object is a list with the following elements.
names(g)
## [1] "mel" "gal" "val" "iel" "oel"
mel: matrix? edges list.gal: graph attributes list.val: vertex attributes list.iel: input edges list.oel: output edges list.For instance, to know if a given vertex is an “input node”, i.e. doesn’t have input edges, and to get predecessors for the vertices that aren’t input nodes we can make:
is_input <- sapply(g$iel, function(x) length(x) == 0)
network.vertex.names(g)[is_input]
## [1] "a" "b" "d" "f" "g"
To know if a given vertex, that is, a “goal node” that doesn’t have output edges:
is_goal <- sapply(g$oel, function(x) length(x) == 0)
network.vertex.names(g)[is_goal]
## [1] "h"
Ok, we can add arbitrary attributes to vertices, edges or the network itself.
set.vertex.attribute(g, "value", seq(5, 40, 5))
We can get the values from the graph
g$val[[2]]$value
## [1] 10
Or through the get.vertex.attribute function.
get.vertex.attribute(g, "value")[2]
## [1] 10
If we are thinking in evaluate the graph as functions:
fun_c <- function(a, b) {
a * exp(b)
}
fun_e <- function(c, d) {
d * tan(c)
}
fun_h <- function(e, f, g) {
(f * pi ** (1 / e)) / g
}
We can store this functions as attributes:
set.vertex.attribute(
g,
"fun",
list(NULL, NULL, fun_c, NULL, fun_e, NULL, NULL, fun_h)
)
And evaluate them:
g$val[[3]]$fun(3, 5)
## [1] 445.2395
An alternative way to do this, that will be useful next:
do.call(g$val[[3]]$fun, list("a"=3, "b"=5))
## [1] 445.2395
eval <- function(node) {
if (length(g$iel[[node]]) == 0) {
# is input_node
return(g$val[[node]]$value)
} else {
param <- list()
for (pred in g$iel[[node]]) {
param[network.vertex.names(g)[pred]] <- eval(pred)
}
g$val[[node]]$value <<- do.call(g$val[[node]]$fun, param)
return(g$val[[node]]$value)
}
}
Let’s test our function with our goal node:
eval(seq_along(g$val)[is_goal])
## [1] 0.9231811
This is equivalent to:
fun_h(fun_e(fun_c(5, 10), 20), 30, 35)
## [1] 0.9231811
Check some internal values:
fun_c(5, 10)
## [1] 110132.3
g$val[[3]]$value
## [1] 110132.3
fun_e(fun_c(5, 10), 20)
## [1] 15.4233
g$val[[5]]$value
## [1] 15.4233
And the final value:
g$val[[8]]$value
## [1] 0.9231811