Exploring finanicial binomial recombining trees with tidygraph

tidygraph.r

# SCROLL TO THE GITHUB COMMENT BELOW FOR THE FULL OUTPUT WITH IMAGES
# COPY AND PASTE THIS FOR EASY ACCESS TO REPRODUCIBLE CODE

# ------------------------------------------------------------------------------
library(tidygraph)
library(ggraph)
library(dplyr)
library(igraph)
library(tibble)

# ------------------------------------------------------------------------------
# Some helper functions
nrow_nodes <- function(graph) {
  nrow(as_tibble(activate(graph, "nodes")))
}

nrow_edges <- function(graph) {
  nrow(as_tibble(activate(graph, "edges")))
}

# ------------------------------------------------------------------------------
# You can create really basic tree structures
my_tree <- create_tree(40, 2, mode = "out")

my_tree %>%
  mutate(lab = 1:40) %>%
  ggraph(layout = "tree") +
  geom_edge_link() +
  geom_node_label(mapping = aes(label = lab)) +
  coord_flip() +
  scale_y_reverse() +
  theme_void()

# In tidygraph, networks are represented as two tidy data frames.
# one is for edges (lines between labels), one is for nodes (the labels)
my_tree

# But notice how these are not recombining trees. In fact, it seems like a
# recombining tree is not a true "tree" as defined in graph theory, so I had
# to come up with my own

# ------------------------------------------------------------------------------

create_binomial_recombining_tree <- function(depth) {
  
  vec <- c()
  sep <- 0L
  
  vec_along <- vector("double", depth - 1)
  last_val <- 1
  for(i in seq_len(depth - 1)) {
    vec_along[i] <- last_val + i
    last_val <- vec_along[i]
  }
  vec_along <- c(1, vec_along)
  
  for(i in vec_along) {
    sep <- sep + 1L
    for(j in seq_len(sep)) {
      k <- j - 1
      new <- c(i + k , i + sep + k, i + k, i + sep + 1 + k)
      vec <- c(vec, new)
    }
  }
  
  edge_list <- matrix(vec, ncol = 2, byrow = TRUE)
  
  itree <- igraph::graph_from_edgelist(edge_list)
  bin_recomb_tree <- tidygraph::as_tbl_graph(itree)
  
  bin_recomb_tree
}

# ------------------------------------------------------------------------------

bin_recomb_tree <- create_binomial_recombining_tree(4)

# Plot it!
bin_recomb_tree %>%
  ggraph(layout = "tree") +
  geom_edge_link() +
  geom_node_label(mapping = aes(label = seq_len(nrow_nodes(bin_recomb_tree)))) +
  coord_flip() +
  scale_y_reverse() +
  theme_void()

# This is neat, but kind of ugly. It doesn't look like our binomial tree structure
# because it flattens out rather than doing the up/down thing. Luckily...
bin_recomb_tree %>%
  ggraph(layout = "sugiyama") +
  geom_edge_link() +
  geom_node_label(mapping = aes(label = seq_len(nrow_nodes(bin_recomb_tree)))) +
  coord_flip() +
  scale_y_reverse() +
  theme_void()

# SUGIYAMA TO THE RESCUE

# ------------------------------------------------------------------------------
# Tidygraph is useful for more than just pictures
# In fact, ggraph is used for the pictures, tidygraph is all about manipulation
# and calculations along networks

# This means we can do something like calculate the up / down price of a stock
# along each node!

bin_recomb_tree <- create_binomial_recombining_tree(5)

init <- 100
up <- 1.1
down <- .9

# Normally this is detected automatically if it was a true "tree"
root_specification <- c(TRUE, rep(FALSE, nrow_nodes(bin_recomb_tree) - 1))

# Below is where the magic happens
# map_bfs_dbl() is a variation on map() that applies the function to each node,
# it comes to each node in the order defined from a breadth first search

bin_recomb_tree_with_prices <- bin_recomb_tree %>%
  mutate(
    
    # The function accepts:
    # path - a data frame of the path taken to the node so far. Will be used
    #        to calculate up/down movements leading up to now
    # node - the index of the current node
    # dist - the distance from the root node
    prices = map_bfs_dbl(root_specification, .f = function(path, node, dist, ...) {
      
      # If we are just starting, return initial stock price
      if(nrow(path) == 0L) {
        return(init)
      }
      
      # Modify the path by adding the current node / dist
      # then calculate the up_down logical values (NA = start, TRUE = down, FALSE = up)
      path_mod <- path %>%
        add_row(node = node, dist = dist) %>%
        mutate(ndiff = node - lag(node),
               up_down = (dist == ndiff))
      
      up_down <- path_mod$up_down
      
      # For every TRUE, replace with the down value
      up_down[up_down == 1]   <- down
      up_down[up_down == 0]   <- up
      up_down[is.na(up_down)] <- 1
      
      # Take the product of the vector of up/down values to cumulate them
      path_multiplier <- prod(up_down)
      
      # Take the initial stock price and multiply it by the up/down path values
      init * path_multiplier
      
    })
  )

# As you can see, the prices Node Data has been filled in!
bin_recomb_tree_with_prices

# ------------------------------------------------------------------------------

# Now we can look at our binomial tree!
bin_recomb_tree_with_prices %>%
  mutate(pretty_prices = round(.N()$prices, 2)) %>%
  ggraph(layout = "sugiyama") +
  geom_edge_link() +
  geom_node_label(mapping = aes(label = pretty_prices)) +
  coord_flip() +
  scale_y_reverse() +
  theme_void()




# ------------------------------------------------------------------------------
# you could wrap this up in a function of some kind
# you could imagine parameterizing around the function to be applied to the up node
# vs the down node or something.

# The beautiful thing is that now we just change the depth and we can get
# much larger trees!

# depth = 10 and then run the same code.
bin_recomb_tree <- create_binomial_recombining_tree(10)

init <- 100
up <- 1.1
down <- .9

# Normally this is detected automatically if it was a true "tree"
root_specification <- c(TRUE, rep(FALSE, nrow_nodes(bin_recomb_tree) - 1))

# Below is where the magic happens
# map_bfs_dbl() is a variation on map() that applies the function to each node,
# it comes to each node in the order defined from a breadth first search

bin_recomb_tree_with_prices_big <- bin_recomb_tree %>%
  mutate(
    
    # The function accepts:
    # path - a data frame of the path taken to the node so far. Will be used
    #        to calculate up/down movements leading up to now
    # node - the index of the current node
    # dist - the distance from the root node
    prices = map_bfs_dbl(root_specification, .f = function(path, node, dist, ...) {
      
      # If we are just starting, return initial stock price
      if(nrow(path) == 0L) {
        return(init)
      }
      
      # Modify the path by adding the current node / dist
      # then calculate the up_down logical values (NA = start, TRUE = down, FALSE = up)
      path_mod <- path %>%
        add_row(node = node, dist = dist) %>%
        mutate(ndiff = node - lag(node),
               up_down = (dist == ndiff))
      
      up_down <- path_mod$up_down
      
      # For every TRUE, replace with the down value
      up_down[up_down == 1]   <- down
      up_down[up_down == 0]   <- up
      up_down[is.na(up_down)] <- 1
      
      # Take the product of the vector of up/down values to cumulate them
      path_multiplier <- prod(up_down)
      
      # Take the initial stock price and multiply it by the up/down path values
      init * path_multiplier
      
    })
  )

bin_recomb_tree_with_prices_big %>%
  mutate(pretty_prices = round(.N()$prices, 2)) %>%
  ggraph(layout = "sugiyama") +
  geom_edge_link() +
  geom_node_label(mapping = aes(label = pretty_prices)) +
  coord_flip() +
  scale_y_reverse() +
  theme_void()

library(tidygraph)
library(ggraph)
library(dplyr)
library(igraph)
library(tibble)

# Some helper functions
nrow_nodes <- function(graph) {
  nrow(as_tibble(activate(graph, "nodes")))
}

nrow_edges <- function(graph) {
  nrow(as_tibble(activate(graph, "edges")))
}

# You can create really basic tree structures
my_tree <- create_tree(40, 2, mode = "out")

my_tree %>%
  mutate(lab = 1:40) %>%
  ggraph(layout = "tree") +
  geom_edge_link() +
  geom_node_label(mapping = aes(label = lab)) +
  coord_flip() +
  scale_y_reverse() +
  theme_void()

# In tidygraph, networks are represented as two tidy data frames.
# one is for edges (lines between labels), one is for nodes (the labels)
my_tree
#> # A tbl_graph: 40 nodes and 39 edges
#> #
#> # A rooted tree
#> #
#> # Node Data: 40 x 0 (active)
#> #
#> # Edge Data: 39 x 2
#>    from    to
#>   <int> <int>
#> 1     1     2
#> 2     1     3
#> 3     2     4
#> # ... with 36 more rows

# But notice how these are not recombining trees. In fact, it seems like a
# recombining tree is not a true "tree" as defined in graph theory, so I had
# to come up with my own

create_binomial_recombining_tree <- function(depth) {
  
  vec <- c()
  sep <- 0L
  
  vec_along <- vector("double", depth - 1)
  last_val <- 1
  for(i in seq_len(depth - 1)) {
    vec_along[i] <- last_val + i
    last_val <- vec_along[i]
  }
  vec_along <- c(1, vec_along)
  
  for(i in vec_along) {
    sep <- sep + 1L
    for(j in seq_len(sep)) {
      k <- j - 1
      new <- c(i + k , i + sep + k, i + k, i + sep + 1 + k)
      vec <- c(vec, new)
    }
  }
  
  edge_list <- matrix(vec, ncol = 2, byrow = TRUE)
  
  itree <- igraph::graph_from_edgelist(edge_list)
  bin_recomb_tree <- tidygraph::as_tbl_graph(itree)
  
  bin_recomb_tree
}

bin_recomb_tree <- create_binomial_recombining_tree(4)

# Plot it!
bin_recomb_tree %>%
  ggraph(layout = "tree") +
  geom_edge_link() +
  geom_node_label(mapping = aes(label = seq_len(nrow_nodes(bin_recomb_tree)))) +
  coord_flip() +
  scale_y_reverse() +
  theme_void()

# This is neat, but kind of ugly. It doesn't look like our binomial tree structure
# because it flattens out rather than doing the up/down thing. Luckily...
bin_recomb_tree %>%
  ggraph(layout = "sugiyama") +
  geom_edge_link() +
  geom_node_label(mapping = aes(label = seq_len(nrow_nodes(bin_recomb_tree)))) +
  coord_flip() +
  scale_y_reverse() +
  theme_void()

# SUGIYAMA TO THE RESCUE

# Tidygraph is useful for more than just pictures
# In fact, ggraph is used for the pictures, tidygraph is all about manipulation
# and calculations along networks

# This means we can do something like calculate the up / down price of a stock
# along each node!

bin_recomb_tree <- create_binomial_recombining_tree(5)

init <- 100
up <- 1.1
down <- .9

# Normally this is detected automatically if it was a true "tree"
root_specification <- c(TRUE, rep(FALSE, nrow_nodes(bin_recomb_tree) - 1))

# Below is where the magic happens
# map_bfs_dbl() is a variation on map() that applies the function to each node,
# it comes to each node in the order defined from a breadth first search

bin_recomb_tree_with_prices <- bin_recomb_tree %>%
  mutate(
    
    # The function accepts:
    # path - a data frame of the path taken to the node so far. Will be used
    #        to calculate up/down movements leading up to now
    # node - the index of the current node
    # dist - the distance from the root node
    prices = map_bfs_dbl(root_specification, .f = function(path, node, dist, ...) {
      
      # If we are just starting, return initial stock price
      if(nrow(path) == 0L) {
        return(init)
      }
      
      # Modify the path by adding the current node / dist
      # then calculate the up_down logical values (NA = start, TRUE = down, FALSE = up)
      path_mod <- path %>%
        add_row(node = node, dist = dist) %>%
        mutate(ndiff = node - lag(node),
               up_down = (dist == ndiff))
      
      up_down <- path_mod$up_down
      
      # For every TRUE, replace with the down value
      up_down[up_down == 1]   <- down
      up_down[up_down == 0]   <- up
      up_down[is.na(up_down)] <- 1
      
      # Take the product of the vector of up/down values to cumulate them
      path_multiplier <- prod(up_down)
      
      # Take the initial stock price and multiply it by the up/down path values
      init * path_multiplier
      
    })
  )

# As you can see, the prices Node Data has been filled in!
bin_recomb_tree_with_prices
#> # A tbl_graph: 21 nodes and 30 edges
#> #
#> # A directed acyclic simple graph with 1 component
#> #
#> # Node Data: 21 x 1 (active)
#>   prices
#>    <dbl>
#> 1   100 
#> 2    90 
#> 3   110.
#> 4    81 
#> 5    99.
#> 6   121.
#> # ... with 15 more rows
#> #
#> # Edge Data: 30 x 2
#>    from    to
#>   <int> <int>
#> 1     1     2
#> 2     1     3
#> 3     2     4
#> # ... with 27 more rows

# Now we can look at our binomial tree!
bin_recomb_tree_with_prices %>%
  mutate(pretty_prices = round(.N()$prices, 2)) %>%
  ggraph(layout = "sugiyama") +
  geom_edge_link() +
  geom_node_label(mapping = aes(label = pretty_prices)) +
  coord_flip() +
  scale_y_reverse() +
  theme_void()

# you could wrap this up in a function of some kind
# you could imagine parameterizing around the function to be applied to the up node
# vs the down node or something.

# The beautiful thing is that now we just change the depth and we can get
# much larger trees!

# depth = 10 and then run the same code.
bin_recomb_tree <- create_binomial_recombining_tree(10)

init <- 100
up <- 1.1
down <- .9

# Normally this is detected automatically if it was a true "tree"
root_specification <- c(TRUE, rep(FALSE, nrow_nodes(bin_recomb_tree) - 1))

# Below is where the magic happens
# map_bfs_dbl() is a variation on map() that applies the function to each node,
# it comes to each node in the order defined from a breadth first search

bin_recomb_tree_with_prices_big <- bin_recomb_tree %>%
  mutate(
    
    # The function accepts:
    # path - a data frame of the path taken to the node so far. Will be used
    #        to calculate up/down movements leading up to now
    # node - the index of the current node
    # dist - the distance from the root node
    prices = map_bfs_dbl(root_specification, .f = function(path, node, dist, ...) {
      
      # If we are just starting, return initial stock price
      if(nrow(path) == 0L) {
        return(init)
      }
      
      # Modify the path by adding the current node / dist
      # then calculate the up_down logical values (NA = start, TRUE = down, FALSE = up)
      path_mod <- path %>%
        add_row(node = node, dist = dist) %>%
        mutate(ndiff = node - lag(node),
               up_down = (dist == ndiff))
      
      up_down <- path_mod$up_down
      
      # For every TRUE, replace with the down value
      up_down[up_down == 1]   <- down
      up_down[up_down == 0]   <- up
      up_down[is.na(up_down)] <- 1
      
      # Take the product of the vector of up/down values to cumulate them
      path_multiplier <- prod(up_down)
      
      # Take the initial stock price and multiply it by the up/down path values
      init * path_multiplier
      
    })
  )

bin_recomb_tree_with_prices_big %>%
  mutate(pretty_prices = round(.N()$prices, 2)) %>%
  ggraph(layout = "sugiyama") +
  geom_edge_link() +
  geom_node_label(mapping = aes(label = pretty_prices)) +
  coord_flip() +
  scale_y_reverse() +
  theme_void()

Created on 2018-05-01 by the reprex package (v0.2.0).