Implement a function that computes the price of an European Call and Put Option. The function should receive as parameters the stock price S0, the time to maturity t-T, the strike price K, the interest rate r, and the volatility . Calculate and output both the price of a call and a put for: S0 = K = 100, time to expiry 1 month, i.e., = 30=252, r = 5%, and = 20%.
library(quantmod)#to get the stock prices
library(rCharts)
library(gsubfn)
QuestionA<-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)
}
print(paste("Call Price=",QuestionA(S=100,K=100,t=30/252,r=.05,sigma=.2,type="c")))
## [1] "Call Price= 3.05118365027145"
print(paste("Put Price=",QuestionA(S=100,K=100,t=30/252,r=.05,sigma=.2,type="p")))
## [1] "Put Price= 2.45771358724366"
Check that the Put-Call parity relation holds, please see Section 4 from [2]. Use the same parameters as above.
QuestionB<-function(S, K, t, r, sigma){
call <- QuestionA(S,K,t,r,sigma,type="c")
put <- QuestionA(S,K,t,r,sigma,type="p")
print("Call - Put = So - Ke^(rt)")
print(paste(call," - ",put, " = ",S," - ",(K*exp(r*t))))
if(abs((abs(call-put)-abs(S-((K*exp(r*t))))))<.01)
print("Put-Call Parity holds")
}
QuestionB(S=100,K=100,t=30/252,r=.05,sigma=.2)
## [1] "Call - Put = So - Ke^(rt)"
## [1] "3.05118365027145 - 2.45771358724366 = 100 - 100.597013157389"
## [1] "Put-Call Parity holds"
The implied volatility is, by denition, the value of for which the function f() = CBSM(S0;K; T; r; ) -???? CM(K; T) is zero. Here, we denoted by CM(K; T) and CBSM(S0;K; T; ) the market price of an European Call Option and the Black{Scholes{Merton price, respectively. Typically, CM(K; T) is taken as the average of best bid and best ask quotes for the respective option from the nancial market. In this problem please download option prices (you can use the Bloomberg Terminal, Yahoo! Finance, etc.) for an equity (any equity not an ETF or index), for 3 dierent maturities (nearest to 1 month, 2 months, and 6 months) and 20 strike prices. Compute the implied volatility using the bisection method for each of these options. Use a tolerance level " = 10????4 and present the results in a table.
#Importing the option chain downloaded from yahoo finance
option_chain_csv <- read.csv(file="call.csv",header=TRUE, sep=",")
#call.csv and put.csv are available in the project folder
option_chain_csv$days_till_expiry <- as.Date(option_chain_csv$Expiry,"%m/%d/%Y")-Sys.Date()
#Calculating the days till expiry
option_chain_csv$premium<-(option_chain_csv$Bid+option_chain_csv$Ask)/2
head(option_chain_csv)
## Strike Contract.Name Last.Price Bid Ask Change X..Change
## 1 90 AAPL170224C00090000 41.66 41.90 42.40 0.00 0.00%
## 2 100 AAPL170224C00100000 32.23 31.90 32.40 0.56 1.77%
## 3 102 AAPL170224C00102000 32.82 0.00 0.00 0.00 0.00%
## 4 104 AAPL170224C00104000 18.11 17.55 18.05 2.60 16.76%
## 5 105 AAPL170224C00105000 26.60 26.95 27.40 0.00 0.00%
## 6 106 AAPL170224C00106000 25.60 25.95 26.40 0.00 0.00%
## Volume Open.Interest Implied.Volatility Type Expiry days_till_expiry
## 1 246 0 0.00% Call 2/24/2017 5 days
## 2 35 0 0.00% Call 2/24/2017 5 days
## 3 5 0 0.00% Call 2/24/2017 5 days
## 4 5 5 0.00% Call 2/24/2017 5 days
## 5 4 0 0.00% Call 2/24/2017 5 days
## 6 3 0 0.00% Call 2/24/2017 5 days
## premium
## 1 42.150
## 2 32.150
## 3 0.000
## 4 17.800
## 5 27.175
## 6 26.175
QuestionC_Bisection<-function(S, K, t, r, type, option_price, max.iter=100000,tolerance=.0001)
{
sigma.upper <- 2
sigma.lower <- 0.001
sigma.mid <- .5
count <- 0
fun.mid <- QuestionA(S=S,K=K,t=t,r=r,sigma=sigma.mid,type=type)- option_price
start.time <- Sys.time()
while(abs(fun.mid) > tolerance && count<max.iter){
fun.upper=QuestionA(S=S,K=K,t=t,r=r,sigma=sigma.upper,type=type)-option_price
fun.lower=QuestionA(S=S,K=K,t=t,r=r,sigma=sigma.lower,type=type)-option_price
fun.mid=QuestionA(S=S,K=K,t=t,r=r,sigma=sigma.mid,type=type)-option_price
if(fun.mid*fun.lower < 0){
sigma.upper <-sigma.mid
sigma.mid <- (sigma.upper + sigma.lower)/2
}else{
sigma.lower<- sigma.mid
sigma.mid <- (sigma.lower + sigma.upper)/2
}
count <- count + 1
}
end.time <- Sys.time()
time.taken <- end.time - start.time
if(count>=max.iter){
return(list(NA,time.taken,count))
}else{
return(list(sigma.mid,time.taken,count))
}
}
iv=QuestionC_Bisection(S=100,K=100,t=30/252,r=.05,type='c',option_price = 3.051184)
print(paste("Implied Volume=",iv[1],"Time taken for calculations=",iv[2], "seconds",
"Number of iterations=",iv[3]))
## [1] "Implied Volume= 0.199972595214844 Time taken for calculations= 0 seconds Number of iterations= 14"
Now that we have build the implementation of bisection method, we’ll implement on our data.
QuestionC<-function(symbol="AAPL"){
stock_df<-as.data.frame(getSymbols(symbol,from = as.Date("2017-01-01"), env = NULL))
option_chain <-option_chain_csv
libor <-.05/100
iv <- {}
original_iv <-{}
optionName <-{}
strike <-{}
days_till_expiry <-{}
time.taken <- 0
iterations <- 0
for (i in 1:nrow(option_chain))
{
try({
bisection <- QuestionC_Bisection(
S = as.numeric(tail(stock_df,1)[6]),
K = as.numeric(option_chain[i,"Strike"]),
t = as.numeric(option_chain[i,"days_till_expiry"])/252,
r = libor,
type = ifelse((option_chain[i,"Type"]=="Call"), "c", "p"),
option_price = as.numeric(option_chain[i,"premium"]))
iv <- append(iv,as.numeric(bisection[1]))
if(!is.na(bisection[1])){
time.taken <- as.numeric(bisection[2])+time.taken
iterations <- as.numeric(bisection[3])+iterations
}
strike<-append(strike,as.numeric(option_chain[i,"Strike"]))
optionName <- append(optionName,paste(option_chain[i,"Strike"],"-",
option_chain[i,"Type"],"Expiring On:",
option_chain[i,"Expiry"]))
days_till_expiry <- append(days_till_expiry,as.numeric(option_chain[i,"days_till_expiry"]))
})
}
option_chain_df <- data.frame(days_till_expiry,optionName,iv,strike)
names(option_chain_df)<-c("Days_till_Expiry","variable","Implied_Volatility","strike")
time.taken <- time.taken/as.numeric(colSums(!is.na(option_chain_df))[3])
iterations <- iterations/as.numeric(colSums(!is.na(option_chain_df))[3])
return(list(option_chain_df,time.taken,iterations))
}
iv.bisection=QuestionC("AAPL")
## As of 0.4-0, 'getSymbols' uses env=parent.frame() and
## auto.assign=TRUE by default.
##
## This behavior will be phased out in 0.5-0 when the call will
## default to use auto.assign=FALSE. getOption("getSymbols.env") and
## getOptions("getSymbols.auto.assign") are now checked for alternate defaults
##
## This message is shown once per session and may be disabled by setting
## options("getSymbols.warning4.0"=FALSE). See ?getSymbols for more details.
options.data <- iv.bisection[1]
options.data <- data.frame(options.data)
options.data <- options.data[complete.cases(options.data$Implied_Volatility),]
To display the data
head(iv.bisection)
## [[1]]
## Days_till_Expiry variable
## 1 5 90 - Call Expiring On: 2/24/2017
## 2 5 100 - Call Expiring On: 2/24/2017
## 3 5 102 - Call Expiring On: 2/24/2017
## 4 5 104 - Call Expiring On: 2/24/2017
## 5 5 105 - Call Expiring On: 2/24/2017
## 6 5 106 - Call Expiring On: 2/24/2017
## 7 5 107 - Call Expiring On: 2/24/2017
## 8 5 108 - Call Expiring On: 2/24/2017
## 9 5 109 - Call Expiring On: 2/24/2017
## 10 5 110 - Call Expiring On: 2/24/2017
## 11 5 111 - Call Expiring On: 2/24/2017
## 12 5 112 - Call Expiring On: 2/24/2017
## 13 5 113 - Call Expiring On: 2/24/2017
## 14 5 114 - Call Expiring On: 2/24/2017
## 15 5 115 - Call Expiring On: 2/24/2017
## 16 5 116 - Call Expiring On: 2/24/2017
## 17 5 117 - Call Expiring On: 2/24/2017
## 18 5 118 - Call Expiring On: 2/24/2017
## 19 5 119 - Call Expiring On: 2/24/2017
## 20 5 120 - Call Expiring On: 2/24/2017
## 21 5 121 - Call Expiring On: 2/24/2017
## 22 5 122 - Call Expiring On: 2/24/2017
## 23 5 123 - Call Expiring On: 2/24/2017
## 24 5 124 - Call Expiring On: 2/24/2017
## 25 5 125 - Call Expiring On: 2/24/2017
## 26 5 126 - Call Expiring On: 2/24/2017
## 27 5 127 - Call Expiring On: 2/24/2017
## 28 5 128 - Call Expiring On: 2/24/2017
## 29 5 129 - Call Expiring On: 2/24/2017
## 30 5 130 - Call Expiring On: 2/24/2017
## 31 5 131 - Call Expiring On: 2/24/2017
## 32 5 132 - Call Expiring On: 2/24/2017
## 33 5 133 - Call Expiring On: 2/24/2017
## 34 5 134 - Call Expiring On: 2/24/2017
## 35 5 135 - Call Expiring On: 2/24/2017
## 36 5 136 - Call Expiring On: 2/24/2017
## 37 5 137 - Call Expiring On: 2/24/2017
## 38 5 138 - Call Expiring On: 2/24/2017
## 39 5 139 - Call Expiring On: 2/24/2017
## 40 5 140 - Call Expiring On: 2/24/2017
## 41 5 141 - Call Expiring On: 2/24/2017
## 42 5 142 - Call Expiring On: 2/24/2017
## 43 5 143 - Call Expiring On: 2/24/2017
## 44 5 144 - Call Expiring On: 2/24/2017
## 45 5 145 - Call Expiring On: 2/24/2017
## 46 5 146 - Call Expiring On: 2/24/2017
## 47 5 147 - Call Expiring On: 2/24/2017
## 48 5 148 - Call Expiring On: 2/24/2017
## 49 5 149 - Call Expiring On: 2/24/2017
## 50 5 150 - Call Expiring On: 2/24/2017
## 51 5 152.5 - Call Expiring On: 2/24/2017
## 52 26 45 - Call Expiring On: 3/17/2017
## 53 26 47.5 - Call Expiring On: 3/17/2017
## 54 26 50 - Call Expiring On: 3/17/2017
## 55 26 55 - Call Expiring On: 3/17/2017
## 56 26 60 - Call Expiring On: 3/17/2017
## 57 26 65 - Call Expiring On: 3/17/2017
## 58 26 70 - Call Expiring On: 3/17/2017
## 59 26 75 - Call Expiring On: 3/17/2017
## 60 26 80 - Call Expiring On: 3/17/2017
## 61 26 82.5 - Call Expiring On: 3/17/2017
## 62 26 85 - Call Expiring On: 3/17/2017
## 63 26 87.5 - Call Expiring On: 3/17/2017
## 64 26 90 - Call Expiring On: 3/17/2017
## 65 26 92.5 - Call Expiring On: 3/17/2017
## 66 26 95 - Call Expiring On: 3/17/2017
## 67 26 97.5 - Call Expiring On: 3/17/2017
## 68 26 100 - Call Expiring On: 3/17/2017
## 69 26 105 - Call Expiring On: 3/17/2017
## 70 26 110 - Call Expiring On: 3/17/2017
## 71 26 115 - Call Expiring On: 3/17/2017
## 72 26 120 - Call Expiring On: 3/17/2017
## 73 26 125 - Call Expiring On: 3/17/2017
## 74 26 130 - Call Expiring On: 3/17/2017
## 75 26 135 - Call Expiring On: 3/17/2017
## 76 26 140 - Call Expiring On: 3/17/2017
## 77 26 145 - Call Expiring On: 3/17/2017
## 78 26 150 - Call Expiring On: 3/17/2017
## 79 26 155 - Call Expiring On: 3/17/2017
## 80 26 160 - Call Expiring On: 3/17/2017
## 81 26 165 - Call Expiring On: 3/17/2017
## 82 26 170 - Call Expiring On: 3/17/2017
## 83 26 175 - Call Expiring On: 3/17/2017
## 84 26 180 - Call Expiring On: 3/17/2017
## 85 26 185 - Call Expiring On: 3/17/2017
## 86 26 190 - Call Expiring On: 3/17/2017
## 87 26 210 - Call Expiring On: 3/17/2017
## 88 152 25 - Call Expiring On: 7/21/2017
## 89 152 40 - Call Expiring On: 7/21/2017
## 90 152 45 - Call Expiring On: 7/21/2017
## 91 152 50 - Call Expiring On: 7/21/2017
## 92 152 60 - Call Expiring On: 7/21/2017
## 93 152 70 - Call Expiring On: 7/21/2017
## 94 152 75 - Call Expiring On: 7/21/2017
## 95 152 80 - Call Expiring On: 7/21/2017
## 96 152 85 - Call Expiring On: 7/21/2017
## 97 152 90 - Call Expiring On: 7/21/2017
## 98 152 95 - Call Expiring On: 7/21/2017
## 99 152 100 - Call Expiring On: 7/21/2017
## 100 152 105 - Call Expiring On: 7/21/2017
## 101 152 110 - Call Expiring On: 7/21/2017
## 102 152 115 - Call Expiring On: 7/21/2017
## 103 152 120 - Call Expiring On: 7/21/2017
## 104 152 125 - Call Expiring On: 7/21/2017
## 105 152 130 - Call Expiring On: 7/21/2017
## 106 152 135 - Call Expiring On: 7/21/2017
## 107 152 140 - Call Expiring On: 7/21/2017
## 108 152 145 - Call Expiring On: 7/21/2017
## 109 152 150 - Call Expiring On: 7/21/2017
## 110 152 155 - Call Expiring On: 7/21/2017
## 111 152 160 - Call Expiring On: 7/21/2017
## 112 152 165 - Call Expiring On: 7/21/2017
## 113 152 170 - Call Expiring On: 7/21/2017
## 114 152 175 - Call Expiring On: 7/21/2017
## 115 152 180 - Call Expiring On: 7/21/2017
## 116 152 185 - Call Expiring On: 7/21/2017
## 117 152 190 - Call Expiring On: 7/21/2017
## 118 152 195 - Call Expiring On: 7/21/2017
## 119 152 205 - Call Expiring On: 7/21/2017
## Implied_Volatility strike
## 1 NA 90.0
## 2 NA 100.0
## 3 NA 102.0
## 4 NA 104.0
## 5 NA 105.0
## 6 NA 106.0
## 7 NA 107.0
## 8 NA 108.0
## 9 NA 109.0
## 10 NA 110.0
## 11 NA 111.0
## 12 NA 112.0
## 13 NA 113.0
## 14 NA 114.0
## 15 NA 115.0
## 16 NA 116.0
## 17 NA 117.0
## 18 NA 118.0
## 19 NA 119.0
## 20 0.3070273 120.0
## 21 0.2933828 121.0
## 22 0.2719414 122.0
## 23 0.2519619 123.0
## 24 0.2319824 124.0
## 25 0.2144395 125.0
## 26 0.1954346 126.0
## 27 NA 127.0
## 28 NA 128.0
## 29 NA 129.0
## 30 0.1569984 130.0
## 31 0.1331814 131.0
## 32 0.1340037 132.0
## 33 0.1409478 133.0
## 34 0.1372626 134.0
## 35 0.1353362 135.0
## 36 0.1327093 136.0
## 37 0.1357397 137.0
## 38 0.1380544 138.0
## 39 0.1468868 139.0
## 40 0.1531000 140.0
## 41 0.1636989 141.0
## 42 0.1750896 142.0
## 43 0.1895869 143.0
## 44 0.1996985 144.0
## 45 0.2129775 145.0
## 46 0.2312515 146.0
## 47 0.2497690 147.0
## 48 0.2586624 148.0
## 49 0.2636572 149.0
## 50 0.3127532 150.0
## 51 0.3204282 152.5
## 52 NA 45.0
## 53 NA 47.5
## 54 NA 50.0
## 55 NA 55.0
## 56 NA 60.0
## 57 NA 65.0
## 58 NA 70.0
## 59 0.6911621 75.0
## 60 NA 80.0
## 61 NA 82.5
## 62 NA 85.0
## 63 0.5230713 87.5
## 64 0.4914722 90.0
## 65 NA 92.5
## 66 0.4308027 95.0
## 67 0.4029045 97.5
## 68 0.4066812 100.0
## 69 0.3681841 105.0
## 70 0.2669465 110.0
## 71 0.2513528 115.0
## 72 0.2128557 120.0
## 73 0.1778307 125.0
## 74 0.1499477 130.0
## 75 0.1383247 135.0
## 76 0.1366382 140.0
## 77 0.1465366 145.0
## 78 0.1612014 150.0
## 79 0.1750896 155.0
## 80 0.1908052 160.0
## 81 0.2078608 165.0
## 82 0.2358809 170.0
## 83 0.2631699 175.0
## 84 NA 180.0
## 85 0.3153115 185.0
## 86 0.3382148 190.0
## 87 0.4561426 210.0
## 88 NA 25.0
## 89 NA 40.0
## 90 NA 45.0
## 91 NA 50.0
## 92 NA 60.0
## 93 NA 70.0
## 94 NA 75.0
## 95 NA 80.0
## 96 NA 85.0
## 97 0.2054852 90.0
## 98 0.2194039 95.0
## 99 0.2177897 100.0
## 100 0.2071527 105.0
## 101 0.1935006 110.0
## 102 0.1859588 115.0
## 103 0.1789766 120.0
## 104 0.1726702 125.0
## 105 0.1675516 130.0
## 106 0.1625758 135.0
## 107 0.1607864 140.0
## 108 0.1577141 145.0
## 109 0.1559420 150.0
## 110 0.1548284 155.0
## 111 0.1545619 160.0
## 112 0.1551177 165.0
## 113 0.1596786 170.0
## 114 0.1583537 175.0
## 115 0.1656481 180.0
## 116 0.1738257 185.0
## 117 0.1716480 190.0
## 118 0.1803890 195.0
## 119 0.1950082 205.0
##
## [[2]]
## [1] 0.0005421576
##
## [[3]]
## [1] 12.57895
Using the same data as in part c), calculate the implied volatilities using the Secant Method and compare the results with the ones in the previous part. What do you observe? Write a paragraph comparing the two methods. Hint: to compare the two algorithms, one can use two indicators: the time to execute the algorithm and the number of iterations necessary to reach convergence.
QuestionD_Secant <- function(S, K, t, r, type, option_price
, x0=0.1, x1=3, tolerance =1e-04, max.iter=10000){
theta=.00001
fun.x1=QuestionA(S=S,K=K,t=t,r=r,sigma=x1,type=type)-option_price
count=1
start.time <- Sys.time()
while(abs(fun.x1) > tolerance && count<max.iter) {
x2=x1-theta
fun.x1=QuestionA(S=S,K=K,t=t,r=r,sigma=x1,type=type)-option_price
fun.x2=QuestionA(S=S,K=K,t=t,r=r,sigma=x2,type=type)-option_price
x1 <- x1- fun.x1/((fun.x1-fun.x2)/theta)
count <-count+1
}
end.time <- Sys.time()
time.taken <- end.time - start.time
if(x2<0 || count>=max.iter)
return(list(NA,time.taken,count))
else
return(list(x2,time.taken,count))
}
iv=QuestionD_Secant(S=100,K=100,t=30/252,r=.05,type='p',option_price = 2.4577)
print(paste("Implied Volume=",iv[1],"Time taken for calculations=",iv[2], "Seconds",
"Number of iterations=",iv[3]))
## [1] "Implied Volume= 0.199992748159112 Time taken for calculations= 0 Seconds Number of iterations= 5"
Now that we have build the secant algorothm, lets give the option chain data
QuestionD<-function(symbol="AAPL"){
stock_df<-as.data.frame(getSymbols(symbol,from = as.Date("2017-01-01"), env = NULL))
option_chain <-option_chain_csv
libor <-.05/100
iv <- {}
original_iv <-{}
optionName <-{}
strike <-{}
days_till_expiry <-{}
time.taken <- 0
iterations <- 0
type <-{}
for (i in 1:nrow(option_chain))
{
try({
secant <- QuestionD_Secant(
S = as.numeric(tail(stock_df,1)[6]),
K = as.numeric(option_chain[i,"Strike"]),
t = as.numeric(option_chain[i,"days_till_expiry"])/252,
r = libor,
type = ifelse((option_chain[i,"Type"]=="Call"), "c", "p"),
option_price = as.numeric(option_chain[i,"premium"]))
iv <- append(iv,100*as.numeric(secant[1]))
if(!is.na(secant[1])){
time.taken <- as.numeric(secant[2])+time.taken
iterations <- as.numeric(secant[3])+iterations
}
type <- append(type,as.character(option_chain[i,"Type"]))
strike<-append(strike,as.numeric(option_chain[i,"Strike"]))
optionName <- append(optionName,paste(option_chain[i,"Strike"],"-",
option_chain[i,"Type"],"Expiring On:",
option_chain[i,"Expiry"]))
days_till_expiry <- append(days_till_expiry,as.numeric(option_chain[i,"days_till_expiry"]))
})
}
option_chain_df <- data.frame(days_till_expiry,type,optionName,iv,strike)
names(option_chain_df)<-c("Days_till_Expiry","Type","Specification","Implied_Volatility","strike")
time.taken <- time.taken/as.numeric(colSums(!is.na(option_chain_df))[3])
iterations <- iterations/as.numeric(colSums(!is.na(option_chain_df))[3])
return(list(option_chain_df,time.taken,iterations))
}
options.data={}
iv.secant=QuestionD("AAPL")
options.data <- iv.secant[1]
options.data <- data.frame(options.data)
options.data <- options.data[complete.cases(options.data$Implied_Volatility),]
head(options.data)
## Days_till_Expiry Type Specification
## 9 5 Call 120 - Call Expiring On: 2/24/2017
## 10 5 Call 121 - Call Expiring On: 2/24/2017
## 11 5 Call 122 - Call Expiring On: 2/24/2017
## 12 5 Call 123 - Call Expiring On: 2/24/2017
## 13 5 Call 124 - Call Expiring On: 2/24/2017
## 14 5 Call 125 - Call Expiring On: 2/24/2017
## Implied_Volatility strike
## 9 30.93073 120
## 10 29.01296 121
## 11 27.10269 122
## 12 25.19905 123
## 13 23.30107 124
## 14 21.40756 125
print(paste("The average time for finding IV using bisection method",iv.bisection[2]))
## [1] "The average time for finding IV using bisection method 0.000542157574703819"
print(paste("The average time for finding IV using secant method",iv.secant[2]))
## [1] "The average time for finding IV using secant method 0.000188830319572898"
print(paste("The average number of steps in bisection method",iv.bisection[3]))
## [1] "The average number of steps in bisection method 12.5789473684211"
print(paste("The average number of steps in secant method",iv.secant[3]))
## [1] "The average number of steps in secant method 7.10588235294118"
print(paste("Which means that Secant method is",round((as.numeric(iv.bisection[2])/as.numeric(iv.secant[2]))-1,4)*100,"% faster than Bisection method"))
## [1] "Which means that Secant method is 187.11 % faster than Bisection method"
print(paste("And Secant method requirs ",round((as.numeric(iv.bisection[3])/as.numeric(iv.secant[3]))-1,4)*100,"% fewer steps than Bisection method"))
## [1] "And Secant method requirs 77.02 % fewer steps than Bisection method"
The above analysis clearly shows that the secant method is much quicker in terms of converging than the Bisection method. This difference is quite evident when we are running the code. But secant method has its own pitfalls, when the tangent of the function never touches the x axis, then the secant would never converge, whereas Bisection doesn’t seem to have that problem. So from my analysis, I have understand that at the end it comes to the tradeoff between speed and success of convergence.
Consider the implied volatility values obtained in either of previous parts. Create a 2 dimensional plot of implied volatilities versus strike K for the closest to maturity options. What do you observe? Plot all implied volatilities for the three dierent maturities on the same plot, where you use a dierent color for each maturity. In total there should be 3 sets of points plotted with dierent color. (BONUS) Create a 3D plot of the same implied vols as a function of both maturity and strike, i.e.: (i;Kj) where i = 1; 2; 3, and j = 1; 2; : : : ; 20.
The above visualization shows the volatility smile and explains that volatility is not constant as assumed in Black sholes model. It can also help us to explain the characterstics of Vega over different strike and time to maturities
library(knitr)
library(rgl)
knit_hooks$set(webgl = hook_webgl)
plot3d(x=options.data$Days_till_Expiry,
y=options.data$Implied_Volatility,
z=options.data$strike,
col = rainbow(1000)) #3d scatter plot
You must enable Javascript to view this page properly.
(Greeks) Calculate the derivatives of the call option price with respect to S (Delta), and (Vega) and the second derivative with respect to S (Gamma). The parameters are as in part a). Approximate these derivatives using an approximation of the partial derivatives. Compare the numbers obtained by the two methods.
QuestionF_delta<-function(S, K, t, r, sigma,type)
{
delta <- (QuestionA(S*1.0001, K, t, r, sigma,type)-QuestionA(S, K, t, r, sigma,type))/
(S*1.0001-S)
return(delta)
}
QuestionF_gamma<-function(S, K, t, r, sigma,type)
{
gamma <- (QuestionF_delta(S+1, K, t, r, sigma,type)-QuestionF_delta(S, K, t, r, sigma,type))/1
}
QuestionF_vega<-function(S, K, t, r, sigma,type)
{
vega <- (QuestionA(S, K, t, r, sigma*1.01,type)-QuestionA(S, K, t, r, sigma,type))/
(sigma*1.01-sigma)
return(abs(vega))
}
delta=QuestionF_delta(S=100,K=100,t=2/252,r=.05,sigma=.2,type="c")
gamma=QuestionF_gamma(S=100,K=100,t=2/252,r=.05,sigma=.2,type="c")
vega=QuestionF_vega(S=100,K=100,t=2/252,r=.05,sigma=.2,type="c")
print(paste("Delta=",delta," Gamma=",gamma," Vega=",vega))
## [1] "Delta= 0.51355607518078 Gamma= 0.209668201905434 Vega= 3.5523403708062"
QuestionF_PD<-function(S, K, t, r, sigma,type)
{
d1 <- (log(S/K)+(r+sigma^2/2)*t)/(sigma*sqrt(t))
d2 <- d1 - sigma * sqrt(t)
#Delta----
if (type == "c")
delta = exp((r)*t)*pnorm(d1)
if (type == "p")
delta = exp((r)*t)*(pnorm(d1)-1)
#Gamma----
gamma = exp((-r)*t)*dnorm(d1)/(S*sigma*sqrt(t))# Call,Put
#Theta----
Theta1 = -(S*exp((r)*t)*dnorm(d1)*sigma)/(2*sqrt(t))
if (type == "c")
theta = Theta1 -
(r)*S*exp((r)*t)*pnorm(+d1) - r*K*exp(-r*t)*pnorm(+d2)
if (type == "p")
theta = Theta1 +
(r)*S*exp((r)*t)*pnorm(-d1) + r*K*exp(-r*t)*pnorm(-d2)
#Vega----
vega = S*exp((r)*t)*dnorm(d1)*sqrt(t) # Call,Put
return(list(delta,gamma,theta,vega))
}
greeks=QuestionF_PD(S=100,K=100,t=2/252,r=.05,sigma=.2,type="c")
print(paste("Delta=",greeks[1]," Gamma=",greeks[2]," Vega=",greeks[4]))
## [1] "Delta= 0.512640584213079 Gamma= 0.223708192199516 Vega= 3.55374299773458"
Apply the formulae developed in part f) to all the options you looked at in part c). To this end use the implied volatilities you previously calculated for each of the options.
QuestiongG<-function(options.data)
{
delta <-{}
gamma <-{}
vega <-{}
libor <- .05/100
stock_df<-as.data.frame(getSymbols("AAPL",from = as.Date("2017-01-01"), env = NULL))
for (i in 1:nrow(options.data))
{
greeks<-QuestionF_PD(
S = as.numeric(tail(stock_df,1)[6]),
K = as.numeric(options.data[i,"strike"]),
t = as.numeric(options.data[i,"Days_till_Expiry"])/252,
r = libor,
type = ifelse((options.data[i,"Type"]=="Call"), "c", "p"),
sigma = as.numeric(options.data[i,"Implied_Volatility"]))
delta <- append(delta, greeks[1])
gamma <- append(gamma,greeks[2])
vega <- append(vega, greeks[4])
}
options.data$Delta <-delta
options.data$Gamma <-gamma
options.data$Vega <-vega
return(options.data)
}
options.data.greeks <- QuestiongG(data.frame(options.data))
head(options.data.greeks$Delta)
## [[1]]
## [1] 0.986342
##
## [[2]]
## [1] 0.980852
##
## [[3]]
## [1] 0.9736216
##
## [[4]]
## [1] 0.964275
##
## [[5]]
## [1] 0.9524113
##
## [[6]]
## [1] 0.9376191
head(options.data.greeks$Gamma)
## [[1]]
## [1] 5.911386e-05
##
## [[2]]
## [1] 8.416178e-05
##
## [[3]]
## [1] 0.0001180177
##
## [[4]]
## [1] 0.0001631518
##
## [[5]]
## [1] 0.0002225936
##
## [[6]]
## [1] 0.0003000912
head(options.data.greeks$Vega)
## [[1]]
## [1] 0.6682597
##
## [[2]]
## [1] 0.8924272
##
## [[3]]
## [1] 1.169029
##
## [[4]]
## [1] 1.502595
##
## [[5]]
## [1] 1.895633
##
## [[6]]
## [1] 2.347936