inst/rmd/AmuaExample/IPS_Export/main.R

In syzoekao/CEAutil: Utility function for Cost-effectiveness analysis at UMN

"
This code was auto-generated by Amua (https://github.com/zward/Amua)
Code generated: Tue Dec 31 11:42:30 CST 2019
Model name: IPS
Model type: Decision Tree
Simulation type: Cohort
Created by: szu-yukao
Created: Tue Dec 31 11:15:56 CST 2019
Version created: 0.2.6
Modified by: szu-yukao
Modified: Tue Dec 31 11:33:17 CST 2019
Version modified: 0.2.6
"

### Define Node Class
setRefClass("Node",
  fields = list(name="character", prob="numeric", 
             costLE="numeric", payoffLE="numeric", expectedLE="numeric", 
             costCost="numeric", payoffCost="numeric", expectedCost="numeric", 
             children="vector")
)

### Define Run tree
evaluateNode <- function(curNode) {
  # Recursive function to average and roll-back tree
  #
  # Args:
  #   curNode: Current node.  Children will be evaluated recursively.

  numChildren <- length(curNode$children)
  if (numChildren == 0) {
    curNode$expectedLE <- curNode$payoffLE + curNode$costLE
    curNode$expectedCost <- curNode$payoffCost + curNode$costCost
  } else {  # Evaluate children
    curNode$expectedLE <- curNode$costLE
    curNode$expectedCost <- curNode$costCost
    for (i in 1:numChildren) {
      child <- tree[[curNode$children[i]]]  # Get child
      evaluateNode(child)
      curNode$expectedLE <- curNode$expectedLE + (child$prob * child$expectedLE)
      curNode$expectedCost <- curNode$expectedCost + (child$prob * child$expectedCost)
    }
  }
}

### Define display results
displayEV <- function(curNode) {
  # Recursive function to display results
  #
  # Args:
  #   curNode: Current node.  Child results will be displayed recursively.
  numChildren <- length(curNode$children)
  if (numChildren > 0) {
    for(i in 1:numChildren) {
      curChild <- tree[[curNode$children[i]]]
      print(paste(curChild$name, curChild$expectedLE, curChild$expectedCost))
      displayEV(curChild)
    }
  }
}


### Define parameters
p_IPS <- 0.6  # Expression: 0.6
p_severe <- 0.3  # Expression: 0.3
LE_severe <- 44.0  # Expression: 44
LE <- 55.0  # Expression: 55
sens <- 0.95  # Expression: 0.95
p_surv <- 0.98  # Expression: 0.98
p_severe_treat <- 0.1  # Expression: 0.1
spec <- 0.7  # Expression: 0.7
C_severe <- 500.0  # Expression: 500
C_treat <- 500.0  # Expression: 500
C_test <- 20.0  # Expression: 20

### Create tree
Root <- new("Node", name="Root", children=c(2, 3, 4))
Donttreat <- new("Node", name="Donttreat", prob=0, costLE=0, costCost=0, payoffLE=0, payoffCost=0, children=c(5, 6))
Treat <- new("Node", name="Treat", prob=0, costLE=0, costCost=0, payoffLE=0, payoffCost=0, children=c(23, 24))
Testtreat <- new("Node", name="Testtreat", prob=0, costLE=0, costCost=0, payoffLE=0, payoffCost=0, children=c(9, 10))
IPS <- new("Node", name="IPS", prob=p_IPS, costLE=0, costCost=0, payoffLE=0, payoffCost=0, children=c(7, 8))
noIPS <- new("Node", name="noIPS", prob=-1, costLE=0, costCost=0, payoffLE=LE, payoffCost=0)
severe <- new("Node", name="severe", prob=p_severe, costLE=0, costCost=0, payoffLE=LE_severe, payoffCost=C_severe)
notsevere <- new("Node", name="notsevere", prob=-1, costLE=0, costCost=0, payoffLE=LE, payoffCost=0)
IPS1 <- new("Node", name="IPS1", prob=p_IPS, costLE=0, costCost=0, payoffLE=0, payoffCost=0, children=c(11, 12))
noIPS1 <- new("Node", name="noIPS1", prob=-1, costLE=0, costCost=0, payoffLE=0, payoffCost=0, children=c(19, 20))
T_plus <- new("Node", name="T_plus", prob=sens, costLE=0, costCost=0, payoffLE=0, payoffCost=0, children=c(13, 14))
T_minus <- new("Node", name="T_minus", prob=-1, costLE=0, costCost=0, payoffLE=0, payoffCost=0, children=c(17, 18))
survive <- new("Node", name="survive", prob=p_surv, costLE=0, costCost=0, payoffLE=0, payoffCost=0, children=c(15, 16))
die <- new("Node", name="die", prob=-1, costLE=0, costCost=0, payoffLE=0, payoffCost=C_test+C_treat)
servere <- new("Node", name="servere", prob=p_severe_treat, costLE=0, costCost=0, payoffLE=LE_severe, payoffCost=C_severe+C_test+C_treat)
notsevere1 <- new("Node", name="notsevere1", prob=-1, costLE=0, costCost=0, payoffLE=LE, payoffCost=C_test+C_treat)
severe1 <- new("Node", name="severe1", prob=p_severe, costLE=0, costCost=0, payoffLE=LE_severe, payoffCost=C_severe+C_test)
notsevere2 <- new("Node", name="notsevere2", prob=-1, costLE=0, costCost=0, payoffLE=LE, payoffCost=C_test)
T_plus1 <- new("Node", name="T_plus1", prob=-1, costLE=0, costCost=0, payoffLE=0, payoffCost=0, children=c(21, 22))
T_minus1 <- new("Node", name="T_minus1", prob=spec, costLE=0, costCost=0, payoffLE=LE, payoffCost=C_test)
survive1 <- new("Node", name="survive1", prob=p_surv, costLE=0, costCost=0, payoffLE=LE, payoffCost=C_test+C_treat)
die1 <- new("Node", name="die1", prob=-1, costLE=0, costCost=0, payoffLE=0, payoffCost=C_test+C_treat)
IPS2 <- new("Node", name="IPS2", prob=p_IPS, costLE=0, costCost=0, payoffLE=0, payoffCost=0, children=c(25, 26))
noIPS2 <- new("Node", name="noIPS2", prob=-1, costLE=0, costCost=0, payoffLE=0, payoffCost=0, children=c(29, 30))
survive2 <- new("Node", name="survive2", prob=p_surv, costLE=0, costCost=0, payoffLE=0, payoffCost=0, children=c(27, 28))
die2 <- new("Node", name="die2", prob=-1, costLE=0, costCost=0, payoffLE=0, payoffCost=C_treat)
severe2 <- new("Node", name="severe2", prob=p_severe_treat, costLE=0, costCost=0, payoffLE=LE_severe, payoffCost=C_severe+C_treat)
notsevere3 <- new("Node", name="notsevere3", prob=-1, costLE=0, costCost=0, payoffLE=LE, payoffCost=C_treat)
survive3 <- new("Node", name="survive3", prob=p_surv, costLE=0, costCost=0, payoffLE=LE, payoffCost=C_treat)
die3 <- new("Node", name="die3", prob=-1, costLE=0, costCost=0, payoffLE=0, payoffCost=C_treat)
tree <- c(Root, Donttreat, Treat, Testtreat, IPS, noIPS, severe, notsevere, IPS1, noIPS1, T_plus, T_minus, survive, die, servere, notsevere1, severe1, notsevere2, T_plus1, T_minus1, survive1, die1, IPS2, noIPS2, survive2, die2, severe2, notsevere3, survive3, die3)

### Define complementary probs
noIPS$prob <- 1.0 - IPS$prob
notsevere$prob <- 1.0 - severe$prob
noIPS1$prob <- 1.0 - IPS1$prob
T_minus$prob <- 1.0 - T_plus$prob
die$prob <- 1.0 - survive$prob
notsevere1$prob <- 1.0 - servere$prob
notsevere2$prob <- 1.0 - severe1$prob
T_plus1$prob <- 1.0 - T_minus1$prob
die1$prob <- 1.0 - survive1$prob
noIPS2$prob <- 1.0 - IPS2$prob
die2$prob <- 1.0 - survive2$prob
notsevere3$prob <- 1.0 - severe2$prob
die3$prob <- 1.0 - survive3$prob

### Run tree
evaluateNode(tree[[1]])

### Display output for each strategy
numStrategies <- length(Root$children)
for(i in 1:numStrategies) {
  curNode <- tree[[Root$children[i]]]
  print(paste("Strategy:", curNode$name, curNode$expectedLE, curNode$expectedCost))
	 print("Children...")
	 displayEV(curNode)
}