Question2
Saeed Rahman
March 8, 2017
A)
Implement a trinomial tree to price European, American Call and Put op- tions.
TrinomialTree = function(isCall, isAmerican=FALSE, K,Tm,
S0, r, sig, N, div=0, dx=0,show=FALSE)
{
# Precompute constants ----
dt = Tm/N
nu = r - div - 0.5 * sig^2
if(dx==0)
# dx=sig*sqrt(3*T/N)
dx = sig*sqrt(3*dt) #Condition in the question
pu = 0.5 * ( (sig^2*dt + nu^2 *dt^2)/dx^2 + nu*dt/dx ) #up move probability
pm = 1.0 - (sig^2*dt + nu^2 *dt^2)/dx^2 #Side move probability
pd = 0.5 * ( (sig^2*dt + nu^2 *dt^2)/dx^2 - nu*dt/dx ) # down move probability.
#pu+pm+pd not necessarily equal to 1
disc = exp(-r*dt) #Discount rate
nRows = 2*N+1 #number of rows
nCols = N+1 #number of columns
cp = ifelse(isCall, 1, -1) #to check if call or put
# Intialize an empty matrix ----
V = S = matrix(0, nrow=nRows, ncol=nCols, dimnames=list(
paste("NumUps", N:-N, sep="="), paste("T", 0:N, sep="=")))
#Initial stock value
S[nCols, 1] = S0
#Fill in the stock matrix with the stock values over different states
for (j in 1:N) {
for(i in (nCols-j+1):(nCols+j-1)) {
S[i-1, j+1] = S[i, j] * exp(dx)
S[i , j+1] = S[i, j]
S[i+1, j+1] = S[i, j] * exp(-dx)
}
}
# Intialize option values at maturity ----
for (i in 1:nRows) {
V[i, N+1] = max( 0, cp * (S[i, N+1]-K))
}
V
# Step backwards through the tree ----
for (j in (nCols-1):1) {
for(i in (nCols-j+1):(nCols+j-1)) {
#converging from N to N-1 state diagonally
V[i, j] = disc * (pu*V[i-1,j+1] + pm*V[i, j+1] + pd*V[i+1,j+1])
if(isAmerican) {
V[i, j] = max(V[i, j], cp * (S[i, j] - K))
}
}
}
V
if(show){
print("Stock Tree")
print(S)
print("Option Value Tree")
print(V)
}
else
return(V[N+1,1])
}
TrinomialTree(isCall=T, isAmerican=F, K=100, T=1.0, div=0.03, S0=100, sig=0.2, r=0.06, N=5,show = TRUE)## [1] "Stock Tree"
## T=0 T=1 T=2 T=3 T=4 T=5
## NumUps=5 0 0.00000 0.00000 0.00000 0.00000 216.97168
## NumUps=4 0 0.00000 0.00000 0.00000 185.83283 185.83283
## NumUps=3 0 0.00000 0.00000 159.16290 159.16290 159.16290
## NumUps=2 0 0.00000 136.32052 136.32052 136.32052 136.32052
## NumUps=1 0 116.75638 116.75638 116.75638 116.75638 116.75638
## NumUps=0 100 100.00000 100.00000 100.00000 100.00000 100.00000
## NumUps=-1 0 85.64843 85.64843 85.64843 85.64843 85.64843
## NumUps=-2 0 0.00000 73.35653 73.35653 73.35653 73.35653
## NumUps=-3 0 0.00000 0.00000 62.82871 62.82871 62.82871
## NumUps=-4 0 0.00000 0.00000 0.00000 53.81180 53.81180
## NumUps=-5 0 0.00000 0.00000 0.00000 0.00000 46.08896
## [1] "Option Value Tree"
## T=0 T=1 T=2 T=3 T=4 T=5
## NumUps=5 0.000000 0.000000 0.00000000 0.0000000 0.000000 116.97168
## NumUps=4 0.000000 0.000000 0.00000000 0.0000000 85.914000 85.83283
## NumUps=3 0.000000 0.000000 0.00000000 59.6357803 59.403605 59.16290
## NumUps=2 0.000000 0.000000 37.48168341 37.0658712 36.697869 36.32052
## NumUps=1 0.000000 19.952263 19.02664238 18.0951108 17.250763 16.75638
## NumUps=0 8.733077 7.628558 6.36240211 4.8407798 2.867669 0.00000
## NumUps=-1 0.000000 1.860571 1.15164221 0.4907697 0.000000 0.00000
## NumUps=-2 0.000000 0.000000 0.08398981 0.0000000 0.000000 0.00000
## NumUps=-3 0.000000 0.000000 0.00000000 0.0000000 0.000000 0.00000
## NumUps=-4 0.000000 0.000000 0.00000000 0.0000000 0.000000 0.00000
## NumUps=-5 0.000000 0.000000 0.00000000 0.0000000 0.000000 0.00000print(paste("European Call Price=",TrinomialTree(isCall=T, isAmerican=F, K=100, T=1.0, div=0.03, S0=100, sig=0.25, r=0.06, N=200)))## [1] "European Call Price= 11.0013233771146"print(paste("American Call Price=",TrinomialTree(isCall=T, isAmerican=T, K=100, T=1.0, div=0.03, S0=100, sig=0.25, r=0.06, N=200)))## [1] "American Call Price= 11.0014725323108"print(paste("European Put Price=",TrinomialTree(isCall=F, isAmerican=F, K=100, T=1.0, div=0.03, S0=100, sig=0.25, r=0.06, N=200)))## [1] "European Put Price= 8.13322338506123"print(paste("American Put Price=",TrinomialTree(isCall=F, isAmerican=T, K=100, T=1.0, div=0.03, S0=100, sig=0.25, r=0.06, N=200)))## [1] "American Put Price= 8.50048552993126"B)
Calculating Implied Volatility
Importing the data from the CSV files and calculating the IV
Calculating the Option Prices Using Trinomial Tree and Black Sholes Merton Formula
PriceCalculator<-function(options.df,show=FALSE){
eur_trinomial <-{}
eur_bsm <-{}
ame_trinomial <-{}
stock_df<-as.data.frame(getSymbols("AAPL",from = as.Date("2017-01-01"),
to=as.Date("2017-02-19"), env = NULL))
for (i in 1:nrow(options.df)){
eur_trinomial <- append(eur_trinomial,TrinomialTree(
isCall = as.logical(options.df[i,"Type"]=="Call"),
K = as.numeric(options.df[i,"Strike"]),
Tm = as.numeric(options.df[i,"Days_till_Expiry"])/252,
S0 = as.numeric(tail(stock_df,1)[6]),
sig = as.numeric(options.df[i,"Implied_Volatility"]),
r = .75/100,
N = 200))
ame_trinomial <- append(ame_trinomial,TrinomialTree(
isAmerican = TRUE,
isCall = as.logical(options.df[i,"Type"]=="Call"),
K = as.numeric(options.df[i,"Strike"]),
Tm = as.numeric(options.df[i,"Days_till_Expiry"])/252,
S0 = as.numeric(tail(stock_df,1)[6]),
sig = as.numeric(options.df[i,"Implied_Volatility"]),
r = .75/100,
N = 200))
eur_bsm <- append(eur_bsm,BSM(
type = ifelse(options.df[i,"Type"]=="Call",'c','p'),
K = as.numeric(options.df[i,"Strike"]),
t = as.numeric(options.df[i,"Days_till_Expiry"])/252,
S = as.numeric(tail(stock_df,1)[6]),
sigma = as.numeric(options.df[i,"Implied_Volatility"]),
r = .75/100))
}
options.df$TrinomialEuropean <- eur_trinomial
options.df$TrinomialAmerican <- ame_trinomial
options.df$BlackSholesMertonEuropean <- eur_bsm
if(show)
head(options.df)
else
return(options.df)
}
PriceCalculator(options.df_call,show=TRUE)## Days_till_Expiry Type Specification
## 8 5 Call 130 - Call Expiring On: 2/24/2017
## 9 5 Call 131 - Call Expiring On: 2/24/2017
## 10 5 Call 132 - Call Expiring On: 2/24/2017
## 11 5 Call 133 - Call Expiring On: 2/24/2017
## 12 5 Call 134 - Call Expiring On: 2/24/2017
## 13 5 Call 135 - Call Expiring On: 2/24/2017
## Implied_Volatility Strike Bid Ask TrinomialEuropean TrinomialAmerican
## 8 0.1360770 130 5.55 5.95 5.750025 5.750025
## 9 0.1146620 131 4.60 4.90 4.749956 4.749956
## 10 0.1267717 132 3.65 3.95 3.800074 3.800074
## 11 0.1373564 133 2.87 3.00 2.935324 2.935324
## 12 0.1350209 134 2.09 2.15 2.120442 2.120442
## 13 0.1337578 135 1.41 1.45 1.430251 1.430251
## BlackSholesMertonEuropean
## 8 5.749994
## 9 4.749993
## 10 3.799978
## 11 2.934957
## 12 2.119940
## 13 1.429927option_chain_call <-PriceCalculator(options.df_call)
option_chain_put <-PriceCalculator(options.df_put)head(option_chain_call)## Days_till_Expiry Type Specification
## 8 5 Call 130 - Call Expiring On: 2/24/2017
## 9 5 Call 131 - Call Expiring On: 2/24/2017
## 10 5 Call 132 - Call Expiring On: 2/24/2017
## 11 5 Call 133 - Call Expiring On: 2/24/2017
## 12 5 Call 134 - Call Expiring On: 2/24/2017
## 13 5 Call 135 - Call Expiring On: 2/24/2017
## Implied_Volatility Strike Bid Ask TrinomialEuropean TrinomialAmerican
## 8 0.1360770 130 5.55 5.95 5.750025 5.750025
## 9 0.1146620 131 4.60 4.90 4.749956 4.749956
## 10 0.1267717 132 3.65 3.95 3.800074 3.800074
## 11 0.1373564 133 2.87 3.00 2.935324 2.935324
## 12 0.1350209 134 2.09 2.15 2.120442 2.120442
## 13 0.1337578 135 1.41 1.45 1.430251 1.430251
## BlackSholesMertonEuropean
## 8 5.749994
## 9 4.749993
## 10 3.799978
## 11 2.934957
## 12 2.119940
## 13 1.429927Plotting the Call Option Prices that are expiring in 5 days
Zoom in to see the difference in prices. Also select legend to deactivate and activate individual series of option prices
# {r,echo=FALSE,results='asis',comment=NA, echo=FALSE, message=FALSE, warning=FALSE, comment=NA}
library(rCharts)
library(reshape)
option_chain_call$Implied_Volatility<-NULL
df_split <-split(option_chain_call,option_chain_call$Days_till_Expiry)
first <-df_split[1]
first <- first$`5`
first[1:2] <- list(NULL)
rownames(first) <- first$Strike
first$Strike <- NULL
a <- Highcharts$new()
a$chart(type = "line")
a$chart(zoomType="xy")
a$title(text = "Apple Call Expiring in 5 Days")
a$xAxis(categories = rownames(first),title = list(text = "Strike"),replace = T)
a$yAxis(title = list(text = "Option Price"))
# a$xAxis(title = "Strikes")
a$data(first)
a$print(include_assets = TRUE)Plotting the Call Option Prices Expiring in 26 days
# {r,echo=FALSE,results='asis',comment=NA, echo=FALSE, message=FALSE, warning=FALSE, comment=NA, results='asis'}
df_split <-split(option_chain_call,option_chain_call$Days_till_Expiry)
first <-df_split[2]
first <- first$`26`
first[1:2] <- list(NULL)
rownames(first) <- first$Strike
first$Strike <- NULL
a <- Highcharts$new()
a$chart(type = "line")
a$chart(zoomType="xy")
a$title(text = "Apple Call Expiring in 26 Days")
a$xAxis(categories = rownames(first),title = list(text = "Strike"),replace = T)
a$yAxis(title = list(text = "Option Price"))
# a$xAxis(title = "Strikes")
a$data(first)
a$print(include_assets = TRUE)Plotting the Option Prices for the Call Expiring in 152 days
df_split <-split(option_chain_call,option_chain_call$Days_till_Expiry)
first <-df_split[3]
first <- first$`152`
first[1:2] <- list(NULL)
rownames(first) <- first$Strike
first$Strike <- NULL
a <- Highcharts$new()
a$chart(type = "line")
a$chart(zoomType="xy")
a$title(text = "Apple Call Expiring in 152 Days")
a$xAxis(categories = rownames(first),title = list(text = "Strike"),replace = T)
a$yAxis(title = list(text = "Option Price"))
# a$xAxis(title = "Strikes")
a$data(first)
a$print(include_assets = TRUE)Plotting the Put Options Prices that are expiring in 5 days
Zoom in to see the difference in prices. Also select legend to deactivate and activate individual series of option prices
option_chain_put$Implied_Volatility<-NULL
df_split <-split(option_chain_put,option_chain_put$Days_till_Expiry)
first <-df_split[1]
first <- first$`5`
first[1:2] <- list(NULL)
rownames(first) <- first$Strike
first$Strike <- NULL
a <- Highcharts$new()
a$chart(type = "line")
a$chart(zoomType="xy")
a$title(text = "Apple Put Options Expiring in 5 Days")
a$xAxis(categories = rownames(first),title = list(text = "Strike"),replace = T)
a$yAxis(title = list(text = "Option Price"))
a$data(first)
a$print(include_assets = TRUE)Plotting the Option Prices for the Puts Expiring in 26 days
df_split <-split(option_chain_put,option_chain_put$Days_till_Expiry)
first <-df_split[2]
first <- first$`26`
first[1:2] <- list(NULL)
rownames(first) <- first$Strike
first$Strike <- NULL
a <- Highcharts$new()
a$chart(type = "line")
a$chart(zoomType="xy")
a$title(text = "Apple Put Options Expiring in 26 Days")
a$xAxis(categories = rownames(first),title = list(text = "Strike"),replace = T)
a$yAxis(title = list(text = "Option Price"))
a$data(first)
a$print(include_assets = TRUE)Plotting the Option Prices for the Puts Expiring in 152 days
df_split <-split(option_chain_put,option_chain_put$Days_till_Expiry)
first <-df_split[3]
first <- first$`152`
first[1:2] <- list(NULL)
rownames(first) <- first$Strike
first$Strike <- NULL
a <- Highcharts$new()
a$chart(type = "line")
a$chart(zoomType="xy")
a$title(text = "Apple Put Options Expiring in 152 Days")
a$xAxis(categories = rownames(first),title = list(text = "Strike"),replace = T)
a$yAxis(title = list(text = "Option Price"))
a$data(first)
a$print(include_assets = TRUE)C)
The plot and the data obtained above with the trinomial tree clearly shows that it has more accuracy in terms in stock price and option price lattice. Eventhough no direct comparison of trinomial tree with the binomial tree with the actual stock price is done in this study, we can see that the finer price lattice will give advantage in terms of pricing exotic options and other complex options. And that is also verified by the error with respect to the blacksholes price calculated in part D) of both the problems
D)
QuestionD<-function(){
bsm_price <- {}
trinomial_price <-{}
error <-{}
iter <-c(10, 20, 30, 40, 50, 100, 150, 200, 250, 300, 350, 400)
for(i in iter){
trinomial_temp <- TrinomialTree(isCall=FALSE,K=100,Tm =1 ,S0 =100 ,sig = .2,N =i,r=.06)
bsm_temp <-BSM(S=100,K=100,t=1,r=.06,sigma=.2,type="p")
trinomial_price <- append(trinomial_price,trinomial_temp)
bsm_price <- append(bsm_price,bsm_temp)
error <- append(error,bsm_temp-trinomial_temp)
}
print(paste("Error=",tail(error,n=1)))
plot(iter,error,xlab = "Number of Iterations",ylab = "Error", type="o",col="blue")
}
QuestionD()## [1] "Error= 0.00460599886943669"
It is very clear that that as the number of steps in the tree increases, the error comes down. And the error is lowest at the highest number of steps which is 400