# required packages
if(require(RCurl) == FALSE) install.packages("RCurl"); require(RCurl)
if(require(jsonlite) == FALSE) install.packages("jsonlite"); require(jsonlite)
if(require(fImport) == FALSE) install.packages("fImport"); require(fImport)
# Get Option Data from Google Finance ---------------------------------------------------------------
# the next two functions work together to parse option chain data from Google Finance
# getOptionsQuote is the main function, it takes the underlying symbol as input
# and returns a list of call and put data by expiration date as output
# fixJason and getOptionsQuote from
# https://mktstk.wordpress.com/2014/12/29/start-trading-like-a-quant-download-option-chains-from-google-finance-in-r/
fixJSON <- function(json_str){
stuff = c('cid','cp','s','cs','vol','expiry','underlying_id','underlying_price',
'p','c','oi','e','b','strike','a','name','puts','calls','expirations',
'y','m','d')
for(i in 1:length(stuff)){
replacement1 = paste(',"', stuff[i], '":', sep = "")
replacement2 = paste('\\{"', stuff[i], '":', sep = "")
regex1 = paste(',', stuff[i], ':', sep = "")
regex2 = paste('\\{', stuff[i], ':', sep = "")
json_str = gsub(regex1, replacement1, json_str)
json_str = gsub(regex2, replacement2, json_str)
}
return(json_str)
}
getOptionQuote <- function(symbol){
output = list()
url = paste('http://www.google.com/finance/option_chain?q=', symbol, '&output=json', sep = "")
x = getURL(url)
fix = fixJSON(x)
json = fromJSON(fix)
numExp = dim(json$expirations)[1]
for(i in 1:numExp){
# download each expirations data
y = json$expirations[i,]$y
m = json$expirations[i,]$m
d = json$expirations[i,]$d
expName = paste(y, m, d, sep = "_")
if (i > 1){
url = paste('http://www.google.com/finance/option_chain?q=', symbol,
'&output=json&expy=', y, '&expm=', m, '&expd=', d, sep = "")
json = fromJSON(fixJSON(getURL(url)))
}
output[[paste(expName, "calls", sep = "_")]] = json$calls
output[[paste(expName, "puts", sep = "_")]] = json$puts
}
return(output)
}
# BS Price and Implied Vol Calculators ----------------------------------------------------------
# the next two functions work together to calculate the implied vol of the options
# the functions are not currently set up to take a dividend yield
BS_Price <- function(S, K, r, Time, vol, IsCall = TRUE){
d1 = (log(S/K) + (r + vol*vol/2)*Time) / (vol * sqrt(Time))
d2 = d1 - vol*sqrt(Time)
Nd1 = pnorm(d1)
Nd2 = pnorm(d2)
if (IsCall){
price = Nd1 * S - Nd2 * K * exp(-r*Time)
}
else{
price = (1-Nd2) * K * exp(-r*Time) - (1-Nd1) * S
}
return(price)
}
Implied_Vol <- function(S, K, r, Time, price, IsCall = TRUE, max_iterations = 100,
root_tol = 1E-4, fun_tol = 1E-6, lx = 0, ux = 5){
# bi-section algorithm to converge on implied volatility
lf = BS_Price(S, K, r, Time, lx, IsCall)
uf = BS_Price(S, K, r, Time, ux, IsCall)
for(i in 1:max_iterations){
root = 1/2 * (ux +lx)
fval = BS_Price(S, K, r, Time, root, IsCall)
if (abs(ux - lx) < root_tol | abs(fval - price) < fun_tol) break
if ((lf < price & fval > price) | (lf > price & fval < price)){
ux = root
uf = fval
}
else{
lx = root
lf = fval
}
}
return(root)
}
# get option chain for HerbaLife - HLF
# HLF will be a list with option chain data for each available expiration
HLF <- getOptionQuote("HLF")
# examine option expiration dates
names(HLF)
## [1] "2015_1_23_calls" "2015_1_23_puts" "2015_1_30_calls"
## [4] "2015_1_30_puts" "2015_2_6_calls" "2015_2_6_puts"
## [7] "2015_2_13_calls" "2015_2_13_puts" "2015_2_20_calls"
## [10] "2015_2_20_puts" "2015_2_27_calls" "2015_2_27_puts"
## [13] "2015_3_20_calls" "2015_3_20_puts" "2015_4_17_calls"
## [16] "2015_4_17_puts" "2015_5_15_calls" "2015_5_15_puts"
## [19] "2015_6_19_calls" "2015_6_19_puts" "2015_8_21_calls"
## [22] "2015_8_21_puts" "2016_1_15_calls" "2016_1_15_puts"
## [25] "2017_1_20_calls" "2017_1_20_puts"
# get chain data for June 2015 expiration - 2 ways to extract list data shown
HLF_calls <- HLF$"2015_6_19_calls"
HLF_puts <- HLF[["2015_6_19_puts"]]
# get last market close for HLF price (S)
HLF_S <- yahooSeries("HLF")[1,6]
HLF_S <- as.numeric(HLF_S)
# 180 day LIBOR
r <- .35490 / 100
# time to expiration
Time <- as.numeric((as.Date("2015-06-19") - Sys.Date()) / 365)
# price = average bid-ask
HLF_calls_price <- (as.numeric(HLF_calls$a) + as.numeric(HLF_calls$b)) / 2
HLF_puts_price <- (as.numeric(HLF_puts$a) + as.numeric(HLF_puts$b)) / 2
# strikes
HLF_strike <- as.numeric(HLF_calls$strike)
# place holder for implied vol
Implied_Vol_Output <- rep(NA, length(HLF_calls_price))
# loop through each option and calc implied vol
for(i in 1:length(Implied_Vol_Output)){
if (HLF_strike[i] > HLF_S){
Implied_Vol_Output[i] <- Implied_Vol(HLF_S, HLF_strike[i], r, Time,
HLF_calls_price[i], TRUE)
}
else{
Implied_Vol_Output[i] <- Implied_Vol(HLF_S, HLF_strike[i], r, Time,
HLF_puts_price[i], FALSE)
}
}
# plot data
plot(HLF_strike, Implied_Vol_Output, main = "HLF Implied Vol", ylab = "HLF_Implied_Vol")
abline(v = HLF_S, col = "green")
text(x = HLF_S, y = 1.05, "HLF Price", cex = .8)
mtext("June 19, 2015 Option Chain")
