This is an R Markdown document. Markdown is a simple formatting syntax for authoring web pages (click the MD toolbar button for help on Markdown).
When you click the Knit HTML button a web page will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
# Standard Stock Priced Tree
library('fExoticOptions')
## Loading required package: timeDate
## Loading required package: timeSeries
## Loading required package: fBasics
## Loading required package: MASS
## Attaching package: 'fBasics'
## The following object(s) are masked from 'package:base':
##
## norm
## Loading required package: fOptions
library('fOptions')
library('RUnit')
stock.price.tree <- function(stock=100,rfree=.08,lvls=3,vol=.3,time=1)
{
per <- time/(lvls-1); #time increment for rate
sq.per <- sqrt(per) #time increment for random walk
intdelta <- exp(rfree*per) #interest rate for binomial model
up <- exp(vol*sq.per) #binomial up increment
dwn <- 1/up #built stock tree from top to bottom
tree <- matrix(0,nrow = lvls, ncol= lvls)
for (rows in 1:lvls)
{
if(rows ==1)
{
tree[1,1] <- stock
next
}
trow <- (up)^(0:(rows-1))*(dwn)^((rows-1):0) #simulate random variation
trow <- stock*trow*intdelta^(rows-1) #add on risk free delta and stock price
tree[rows,1:rows] <- trow #st
}
tree
}
## Simply takes Geometric Mean of Each row in model by dividing by level (sort of useless)
stock.geom.average.price.tree <-
function(stock=100,rfree=.08,lvls=3,vol=.3,time=1)
{
spt <- stock.price.tree(stock=100,rfree=.08,lvls=3,vol=.3,time=1)
lvls <- dim(spt)
lvls <- lvls[1]
for (mod in 2:lvls) spt[mod,1:mod] = exp(log(spt[mod,1:mod]/mod))
spt
}
# initializes a storage matrix, with initial stored value firstval
newtree <- function(firstval,inc) {
m <- matrix(rep(NA,inc*3),nrow=inc,ncol=3)
m[1,3] <- firstval
return(list(mat=m,nxt=2,inc=inc))
}
# inserts newval into nonempty tree whose head is index hdidx in the
# storage space treeloc; note that return value must be reassigned to
# tree; inc is as in newtree() above if node is filled produce error
ins.tree <- function(hdidx=1,tree,newval,inc=20,dr=1) {
tr <- tree
# check for room to add a new element
if (tr$nxt > nrow(tr$mat))
tr$mat <- rbind(tr$mat,matrix(rep(NA,inc*3),nrow=inc,ncol=3))
node <- tr$mat[hdidx,]
if (!is.na(node[dr]))
{
print('node has marked child')
return(tr)
}
else
{
newidx <- tr$nxt # where we'll put the new tree node
tr$mat[newidx,3] <- newval
idx <- hdidx # marks our current place in the tree
nodeval <- node[3]
tr$mat[idx,dr] <- newidx
}
tr$nxt <- tr$nxt + 1
return(tr)
}
## Prints Labeled Bracketing for Trees
tree.str <- NULL
## Constructs the label brakceting routine
print.tree <- function(hdidx,tree)
{
tree.str <<- NULL
printstring(hdidx,tree)
print(tree.str)
tre.str <- NULL
}
## Recursive Tree Construction
printstring <- function(hdidx,tree)
{
tree.str <<- paste(tree.str, '[', as.character(tree$mat[hdidx,3]),sep="")
left <- tree$mat[hdidx,1]
if (!is.na(left)) printstring(left,tree)
right <- tree$mat[hdidx,2]
if (!is.na(right)) printstring(right,tree)
tree.str <<- paste(tree.str, ']',sep="")
}
## Returns terminal nodes of tree
tree.terms <- function(tree)
{
nvec <- NULL
for (ind in 1:(tree$nxt-1))
{
node <- tree$mat[ind,]
if(is.na(node[1]) && is.na(node[2]))
nvec <- c(nvec,ind)
}
nvec
}
## Calculate Asian Option Mean Price Binomial Tree
mean.bin.tree <- function(stock=100,rfree=.08,lvls=3,vol=.3,time=1,flg='a')
{
spt <- stock.price.tree(stock,rfree,lvls,vol,time)
c.tree <- newtree(spt[1,1],10)
c.ptr <- newtree(1,10)
left <- 1
right <- 2
val <- 3
inc <- 20
for (il in 2:lvls)
{
node.list <- tree.terms(c.tree)
node.ptr <- tree.terms(c.ptr)
for(i in 1:length(node.list))
{
nodep <- c.ptr$mat[node.ptr[i],]
node <- c.tree$mat[node.list[i],]
q <- nodep[val]
if (flg == 'a')
{
c.tree <- ins.tree(node.list[i],c.tree,((il-1)*node[val]+spt[il,q])/il,inc,left)
c.tree <- ins.tree(node.list[i],c.tree,((il-1)*node[val]+spt[il,q+1])/il,inc,right)
}
else
{
c.tree <- ins.tree(node.list[i],c.tree,((node[val]^(il-1)*spt[il,q])^(1/il)),inc,left)
c.tree <- ins.tree(node.list[i],c.tree,((node[val]^(il-1)*spt[il,q+1])^(1/il)),inc,right)
}
c.ptr <- ins.tree(node.ptr[i],c.ptr,q,inc,left)
c.ptr <- ins.tree(node.ptr[i],c.ptr,q+1,inc,right)
}
}
c.tree
}
## Returns parent of Node
parent.node <- function(tree,idx)
{
left <- 1
right <- 2
if(idx ==1)
return(-1 ) #base of tree
for(ind in 1:(idx-1))
{
node <- tree$mat[ind,]
if(node[left] == idx || node[right] == idx)
break
}
ind
}
## Averages a node in a Tree
av.t <- function(tree,base,p,disc)
{
val <- 3
left <- 1
right <- 2
node <- tree$mat[base,]
left <- node[left]
right <- node[right]
node[val] = disc*(p*tree$mat[left,val]+(1-p)*tree$mat[right,val])
tree$mat[base,] <- node
tree
}
## Creates Asian Option average price tree, option value and -+
asian.option.binomial.price.tree <- function(stock=100,strike=100,rfree=.08,lvls=3,vol=.3,time=1,flg='a')
{
#use minimal structure of binary tree
per <- time/(lvls-1)
val <- 3
sq.per <- sqrt(per)
c.tree <- mean.bin.tree(stock,rfree,lvls,vol,time,flg)
d.tree <- c.tree
up <- exp(vol*sq.per)
dwn <- 1/up
Df = exp(-rfree*per)
pr <- (up - 1/Df)/(up-dwn)
tinds <- tree.terms(c.tree)
for (ind in tinds) #make price tree value of asian option at base for path
{
node <- d.tree$mat[ind,]
node[val] <- max(node[val]-strike,0)
d.tree$mat[ind,] <- node
}
d.tree <- opt.tree(d.tree,tinds,pr,Df)
list(tree= d.tree, s.tree=c.tree, value= d.tree$mat[1,3])
}
## Construct option Tree using risk free probabilities from base
opt.tree <- function(tree,tinds,pr,Df)
{
sv.inds <- tinds
while(length(sv.inds))
{
s.inds <- sv.inds
nsv.inds <- NULL
for (ind in s.inds)
{
idx <- parent.node(tree,ind)
if(idx == -1) #Get here when trying to get parent of base
{
sv.inds <- NULL
break
}
node <- tree$mat[idx,]
left <- node[1]
right <- node[2]
nsv.inds <- c(nsv.inds,idx)
tree <- av.t(tree,idx,pr,Df)
s.inds <- setdiff(s.inds,c(left,right))
}
sv.inds <- nsv.inds
}
tree
}
#Create Geometric Average Strike Tree
asian.option.binomial.strike.tree <- function(stock=100,strike=100,rfree=.08,lvls=3,vol=.3,time=1,flg='a')
{
per <- time/(lvls-1)
sq.per <- sqrt(per)
up <- exp(vol*sq.per)
dwn <- 1/up
Df = exp(-rfree*per)
pr <- (up - 1/Df)/(up-dwn)
c.tree <- mean.bin.tree(stock,rfree,lvls,vol,time,flg)
d.tree <- c.tree
val <- 3
spt <- stock.price.tree(stock,rfree,lvls,vol,time)
terms <- tree.terms(c.tree)
for (indt in terms)
{
dv <- dirs.tree(c.tree,indt)
node <- c.tree$mat[indt,]
node[val] <- max(spt[lvls,dv$u+1] - node[val],0)
c.tree$mat[indt,] <- node
}
c.tree <- opt.tree(c.tree,terms,pr,Df)
list(tree=c.tree, s.tree=d.tree, value= c.tree$mat[1,3])
}
dirs.tree <- function(tree,indt)
{
left <- 1
sindt <- indt
q <- parent.node(tree,indt); up <- 0; dwn <- 0;
while(!(q == -1))
{
node <- tree$mat[q,]
if(node[left] == indt) dwn<- dwn+1
else up <- up +1
indt <- q
q <- parent.node(tree,indt)
}
list(u=up,d=dwn)
}