R/estimate_tree.R

In DARTH-git/Dectree: Decision Tree Constructor

#' Estimate Decision Tree Function
#'
#' This function estimates final payoffs from a decision tree object.
#' @param tree a decision tree/graph object generated by create_tree()
#' @param payoffs a list of cost/effect column names to use during estimation
#'
#' @return list with tree outcomes (pathprobabs, payoffs, weighted payoffs) by strategy
#'
#' @examples
#' results <- estimate_tree(tree, c("cost","effect"))
#'
#' @export

estimate_tree <- function(tree, payoffs = NULL) {
  # get root and terminal nodes
  root_node      <- V(tree)[V(tree)$type == ROOT]
  terminal_nodes <- V(tree)[V(tree)$type == END]

  # get all possible paths from root to terminal
  pathways <- all_simple_paths(tree, from = root_node, to = terminal_nodes, mode = "all")

  # get all strategies in the tree
  strategies <- c()
  for (j in 1:length(pathways)) {
    strategies <- c(strategies, pathways[[j]][2])
  }

  strategies <- unique(names(strategies))
  n.strat <- length(strategies) # total number of strategies

  # separate pathways by strategy
  l <- rep(list(list()), n.strat)
  k <- 1
  for (i in 2:length(pathways)) {
    if (pathways[[i]][2] == pathways[[i-1]][2]) {
      l[[k]] <- append(l[[k]], pathways[i-1])
    }  else {
      l[[k]] <- append(l[[k]], pathways[i-1])
      k <- k + 1
    }
    if (i==length(pathways)) {
      l[[k]] <- append(l[[k]], pathways[i])
    }
  }

  # empty list to store results of each strategy
  results_all <- rep(list(list()), n.strat)
  names(results_all) <- rep('', n.strat)

  # loop through the strategies and calculate payoffs for each strategy
  for (k in 1:n.strat) {

    pathways <- l[[k]]
    strategy <- attr(pathways[[1]][2], "names")

    #calculate path probability for every path in the tree
    weights       <- sapply(pathways, function(x) prod(E(tree, path = x)$probability))

    #create a matrix with nrows = # terminal nodes and ncols = # outcomes you want to measure

    pay           <- matrix(nrow = length(pathways), ncol = length(payoffs))
    colnames(pay)  <- payoffs

    # iterate through the requested payoffs and include them in the estimation
    for (i in payoffs) {

      # standard expression to sum attributes (payoffs) for all paths in the tree
      expr <- paste("sapply(pathways, function(x) sum(E(tree, path = x)$", i, "))", sep = "")

      # apply standard expression to the tree to calculate the payoffs for every path
      pay[, i] <- eval(parse(text = expr))
    }

    # multiply path probabilities (vector) with path payoffs and return all results separately
    e.payoffs <- weights %*% pay

    # store results
    results <- list(weights = weights, pay = pay, payoffs = e.payoffs)
    results_all[[k]] <- append(results_all[[k]], results)
    names(results_all)[k] <- strategy
  }

  return(results_all)
}