binomialOptionPricing.R

nate — Jul 8, 2014, 9:43 PM

recursiveTree <- function(S, K, sigma, r, delta, h, T=1) {
  if(T!=1) {  r = r*T; h = h*T; delta = delta*T; sigma = sigma*sqrt(T) }

  u = exp((r-delta)/h + sigma*sqrt(1/h)); d = exp((r-delta)/h - sigma*sqrt(1/h))
  p = (exp((r-delta)/h) - d)/(u-d)

  cost <- function(node) {
    if(length(node)==h) return(max(0,Sundn(node) - K))
    else return(max(exp(-(r-delta)/h)*(p*cost(c(node,1)) + (1-p)*cost(c(node,0))),0))
  }

  Sundn <- function(node) {
    un = sum(node); dn = length(node) - un
    S*u^un*d^dn
  }

  cost(numeric(0))
}

treeDetails <- function(n=2, call=TRUE) {
  S = 41; K = 40; sigma = 0.3; r = 0.08; delta = 0; h = n; T = 1
  if(T!=1) r = r*T; h = h*T; delta = delta*T; sigma = sigma*sqrt(T)

  type=call
  factor = ifelse(type==TRUE, -1, 1)

  u = exp((r-delta)/h + sigma*sqrt(1/h))
  d = exp((r-delta)/h - sigma*sqrt(1/h))  
  p = (exp((r-delta)/h) - d)/(u-d)

  tree = list()
  for(i in h:0) {
    node <- numeric(0)
    value <- numeric(0)
    Delta <- numeric(0)
    lend <- numeric(0)

    for(j in 0:i) {
      node = c(node, S*u^(i-j)*d^j)
      if(i==h) {
        value = c(value, max(factor*(K-S*u^(i-j)*d^j), 0))
        Delta = NA
        lend = NA
      } else {
        Delta = c(Delta, (tree[[i+2]]$C[j+1] - tree[[i+2]]$C[j+2])/(tree[[i+2]]$S[j+1] - tree[[i+2]]$S[j+2]))
        lend = c(lend, exp(-(r-delta)/h)*(u*tree[[i+2]]$C[j+2] - d*tree[[i+2]]$C[j+1])/(u-d))
        value = c(value, max(exp(-(r-delta)/h)*(p*tree[[i+2]]$C[j+1] + (1-p)*tree[[i+2]]$C[j+2]),0))
      }
    }
    level = list(S=node, C=value, D=Delta, B=lend)
    tree[[i+1]] = level
  }
  return(tree)
}

treeBasic <- function(n=3, call=TRUE) {
  S = 41; K = 40; sigma = 0.3; r = 0.08; delta = 0; h = n; T = 1
  if(T!=1) r = r*T; h = h*T; delta = delta*T; sigma = sigma*sqrt(T)

  type=call
  factor = ifelse(type==TRUE, -1, 1)

  u = exp((r-delta)/h + sigma*sqrt(1/h))
  d = exp((r-delta)/h - sigma*sqrt(1/h))  
  p = (exp((r-delta)/h) - d)/(u-d)

  for(i in h:0) {
    value <- numeric(0)
    for(j in 0:i) {
      if(i==h) {
        value = c(value, max(factor*(K-S*u^(i-j)*d^j), 0))
      } else {
        value = c(value, max(exp(-(r-delta)/h)*(p*last[j+1] + (1-p)*last[j+2]),0))
      }
    }
    last = value
  }
  return(last)
}

blackscholes <- function(S, X, rf, T, sigma) {  
  d1 <- (log(S/X)+(rf+sigma^2/2)*T)/sigma*sqrt(T)
  d2 <- d1 - sigma * sqrt(T)

  call = S*pnorm(d1) - X*exp(-rf*T)*pnorm(d2)
  put  =  X*exp(-rf*T) * pnorm(-d2) - S*pnorm(-d1)
  return(call)
}

printDetails <- function(tree) {
  for(i in 1:length(tree)) {
    cat("Branch", (i-1), "\n")
    cat("S: ", tree[[i]]$S, "\n")
    cat("C: ", tree[[i]]$C, "\n")
    cat("D: ", tree[[i]]$D, "\n")
    cat("B: ", tree[[i]]$B, "\n")
    cat("\n")
  }
}

prices <- numeric(0)
for(i in 1:20) {   
  prices = c(prices,treeBasic(i))
}

plot(prices, type='l')
abline(blackscholes(41,40, 0.08, 1, 0.3), 0)

ans = treeDetails(3)
#printDetails(ans)