Construct a binomial tree to calculate the price of an European Up-and-Out call option. Use S 0 = 10, strike K = 10, maturity T = 0.3, volatility σ = 0.2, short rate r = 0.01, dividends δ = 0, and barrier H = 11. Use as many steps in your tree as you think are necessary
BinomialTree = function(isCall, isAmerican=FALSE, K=100, Tm=1,
S0=100, r=0.06, sig=0.2, N=3, u=1.1, d=1/u,div=0,show=FALSE)
{
# Precompute constants ----
dt = Tm/N
nu=r-div-0.5*sig*sig
dxu=sqrt(sig*sig*dt+((nu*dt)^2))
dxd=-dxu
pu=0.5+0.5*(nu*dt/dxu)
pd=1-pu
disc=exp(-r*dt)
nRows = 2*N+1 #number of rows for the matrix
nCols = N+1 #number of columns
cp = ifelse(isCall, 1, -1) # to check ifts a call or a put
# Intialize asset prices ----
# Creating a matrix of nRows*nColumns with zeros and headings
V = S = matrix(0, nrow=nRows, ncol=nCols, dimnames=list(
paste("NumUps", N:-N, sep="="), paste("T", 0:N, sep="=")))
S[nCols, 1] = S0 # initial stock price
# iterating the elements of the matrix in a conical manner starting
# from the position of initial stock price
# For n=3, S[i,j]= S0, then update the forward diagonal elements
# Code is similar to the one used for trinomial tree
for (j in 1:N) {
for(i in (nCols-j+1):(nCols+j-1)) {
S[i-1, j+1] = S[i, j]*exp(dxu)
S[i+1, j+1] = S[i, j] *exp(dxd)
}
}
for (i in 1:nRows) {
V[i, nCols] = max( 0, cp * (S[i, nCols]-K))
}
# Step backwards through the tree ----
for (j in (nCols-1):1) {
for(i in (nCols-j+1):(nCols+j-1)) {
# V[i, j] = disc * (p*V[i-1,j+1] + (1-p)*V[i+1,j+1])
V[i, j] = disc * (pu*V[i-1,j+1] + pd*V[i+1,j+1])
if(isAmerican) {
# if american option, then take the Value at each node as the max of the
# value of option or the payoff at that period
V[i, j] = max(V[i, j], cp * (S[i, j] - K))
}
}
}
if(show)
{
print("Stock Tree")
print(S)
print("Option Value Tree")
print(V)
}
else
return(V[nCols,1])
}#Exotic using binomial tree method----
BinomialTreeExotic = function(isCall, isAmerican=FALSE, K=100, Tm=1,
S0=100, r=0.06, sig=0.2, N=3,div=0,type,barrier=100)
{
# Precompute constants ----
dt = Tm/N
nu=r-div-0.5*sig*sig
dxu=sqrt(sig*sig*dt+((nu*dt)^2))
dxd=-dxu
pu=0.5+0.5*(nu*dt/dxu)
pd=1-pu
disc=exp(-r*dt)
nRows = 2*N+1 #number of rows for the matrix
nCols = N+1 #number of columns
cp = ifelse(isCall, 1, -1) # to check ifts a call or a put
# Intialize asset prices ----
# Creating a matrix of nRows*nColumns with zeros and headings
V = S = matrix(0, nrow=nRows, ncol=nCols, dimnames=list(
paste("NumUps", N:-N, sep="="), paste("T", 0:N, sep="=")))
S[nCols, 1] = S0 # initial stock price
# iterating the elements of the matrix in a conical manner starting
# from the position of initial stock price
# For n=3, S[i,j]= S0, then update the forward diagonal elements
# Code is similar to the one used for trinomial tree
for (j in 1:N) {
for(i in (nCols-j+1):(nCols+j-1)) {
S[i-1, j+1] = S[i, j]*exp(dxu)
S[i+1, j+1] = S[i, j] *exp(dxd)
}
}
# print(S)
for (i in 1:nRows) {
if(type=="UO"){
V[i,nCols] <- ifelse((S[i,nCols]<barrier),max(0,cp * (S[i, nCols]-K)),0)
}
else if(type=="DO")
V[i,nCols] <- ifelse((S[i,nCols]>barrier),max(0,cp * (S[i, nCols]-K)),0)
# V[i, nCols] = max( 0, (cp * (S[i, nCols]-K))
}
# print(V)
# V
# Step backwards through the tree ----
for (j in (nCols-1):1) {
for(i in (nCols-j+1):(nCols+j-1)) {
# V[i, j] = disc * (p*V[i-1,j+1] + (1-p)*V[i+1,j+1])
V[i, j] = disc * (pu*V[i-1,j+1] + pd*V[i+1,j+1])
if(isAmerican)
# if american option, then take the Value at each node as the max of the
# value of option or the payoff at that period
V[i, j] = max(V[i, j], cp * (S[i, j] - K))
if(type=="UO" && S[i,j]>=barrier){
V[i,j] <- 0
}
else if(type=="DO" && S[i,j]<=barrier){
V[i,j] <- 0
# V[i, nCols] = max( 0, (cp * (S[i, nCols]-K))
}
}
}
# print(V)
return(V[nCols,1])
}
Barrier<-function(isCall, isAmerican, K, Tm,S0, r, sig, N, div, type, barrier){
if (type=="UO" || type=="DO"){
return(BinomialTreeExotic(isCall=isCall, isAmerican=isAmerican, K=K, Tm=Tm,
S0=S0, r=r, sig=sig, N=N,div=div,type=type,barrier=barrier))
}
else if(type=="UI"){
binomial_price <- BinomialTree(isCall=isCall, isAmerican=isAmerican, K=K, Tm=Tm,
S0=S0, r=r, sig=sig, N=N,div=div)
exotic_price <-BinomialTreeExotic(isCall=isCall, isAmerican=isAmerican, K=K, Tm=Tm,
S0=S0, r=r, sig=sig, N=N,div=div,type="UO",barrier=barrier)
return(binomial_price-exotic_price)
}
else if(type=="DI"){
binomial_price <- BinomialTree(isCall=isCall, isAmerican=isAmerican, K=K, Tm=Tm,
S0=S0, r=r, sig=sig, N=N,div=div)
exotic_price <-BinomialTreeExotic(isCall=isCall, isAmerican=isAmerican, K=K, Tm=Tm,
S0=S0, r=r, sig=sig, N=N,div=div,type="DO",barrier=barrier)
return(binomial_price-exotic_price)
}
}
print(paste("Price of European Up and Out call=",Barrier(isCall=TRUE,isAmerican = FALSE ,K=10,Tm =.3 ,S0 =10 ,sig = .2, N =200, r=.01,type ="UO",barrier = 11, div=0))) ## [1] "Price of European Up and Out call= 0.0626210981999978"For the European Up-and-Out Call option explicit formulas exist. For ex- ample, implement the formula (5.2) from [2] and compare your results with part (a). Use the same parameters as before. Are your results matching?
#Black sholes merton pricing function----
BSM<-function(S, K, t, r, sigma,type){
d1 <- (log(S/K)+(r+sigma^2/2)*t)/(sigma*sqrt(t))
d2 <- d1 - sigma * sqrt(t)
if (type == "c")
result <- S*pnorm(d1) - K*exp(-r*t)*pnorm(d2)
if (type == "p")
result <- K*exp(-r*t) * pnorm(-d2) - S*pnorm(-d1)
return(result)
}
#Exotic using analytical----
ExoticAnalytical<-function(S0,Tm,K,div=0,r,isCall=TRUE,sig,barrier,type){
lamda=(r-div+sig*sig/2)/(sig*sig)
y=log(barrier*barrier/(S0*K))/(sig*sqrt(Tm))+lamda*sig*sqrt(Tm)
x1=log(S0/barrier)/(sig*sqrt(Tm)+lamda*sig*sqrt(Tm))
y1=log(barrier/S0)/(sig*sqrt(Tm)+lamda*sig*sqrt(Tm))
cui=(S0*pnorm(x1)*exp(-div*Tm)-K*exp(-r*Tm)*pnorm(x1-sig*sqrt(Tm)))
-S0*exp(-div*Tm)*((barrier/S0)^(2*lamda))*(pnorm(-y)-pnorm(-y1))
+K*exp(-r*Tm)*((barrier/S0)^(2*lamda-2))*(pnorm(-y+sig*sqrt(Tm)) -pnorm(-y1+sig*sqrt(Tm)))
cuo= BSM(S=S0,K=K,t=Tm,r=r,sigma=sig,type="c")-cui
if(type=="UO")
return(cuo)
else if(type=="UI")
return(cui)
}
print(paste("Analytical price of European Up and Out call option=",ExoticAnalytical(S0=10,T=.3,K=10,div=0,r=.01,
sig=.20,isCall=TRUE,barrier=11,type="UO")))## [1] "Analytical price of European Up and Out call option= 0.0679967580950875"Price an European Up-and-In call option, using the same parameters as before.
print(paste("Binomial price of European Up and Out call option=",Barrier(isCall=TRUE,isAmerican = FALSE ,K=10,Tm =.3 ,S0 =10 ,sig = .2, N =200, r=.01,type ="UI",barrier = 11, div=0)))## [1] "Binomial price of European Up and Out call option= 0.388122318897236"print(paste("Analytical price of European Up and IN call option=",ExoticAnalytical(S0=10,T=.3,K=10,div=0,r=.01,
sig=.20,isCall=TRUE,barrier=11,type="UI")))## [1] "Analytical price of European Up and IN call option= 0.383290886785811"The results between the analytical and the binomial method for calculating the barrier options are very close. The difference in price could possibly even if more number of steps are used.
Calculate the price of an AMERICAN Up and In Put option
H2S=11*11/10
r=.01
div=0
sig=.2
power=1-(2*(r-div)/(sig*sig))
m_factor=((10/11)^power)
put_eur = BinomialTree(isCall=FALSE,isAmerican = FALSE ,K=10,Tm =.3 ,S0 =H2S ,sig = .2, N =200, r=.01, div=0)
put_ame = BinomialTree(isCall=FALSE,isAmerican = TRUE ,K=10,Tm =.3 ,S0 =H2S ,sig = .2, N =200, r=.01, div=0)
put_barrier_eur= Barrier(isCall=FALSE,isAmerican = FALSE ,K=10,Tm =.3 ,S0 =10 ,sig = .2, N =200, r=.01,type ="UI",barrier = 11, div=0)
put_barrier_ame = m_factor*(put_ame-put_eur)+put_barrier_eur
print(paste("American Up and In Put price=",put_barrier_ame))## [1] "American Up and In Put price= 0.0137031548482301"