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"

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