Here are the code and data file. I’m not sure if I put too much unrelated
information here.
My goal is to factor out volatilities from the data. I hope I can get sigV <-
impVolC(callM, K, T, F, r), which has five vectors as input, and one vector as
output. The length of all those six vectors are the same. However, I got stuck
in the nested if-else sentence, as if-condition cannot handle vectors. I
rewrite it as you guys suggestions, however, I still have one layer of
if-condition. Any thoughts to improve it? Thanks.
Lynette
df <- read.csv(file = "/S&P500_ETF_Option_0917.csv", header = TRUE,
colClasses = c("integer", "character", "numeric", "numeric",
"numeric",
"character", "numeric", "numeric", "numeric"))
call <- (df$callBid + df$callAsk)/2
put <- (df$putBid + df$putAsk)/2
y <- call - put
A <- cbind(rep(1, dim(df)[1]), -df$Strike)
x <- solve(t(A)%*%A)%*%t(A)%*%y
PVF <- x[1]
disc <- x[2]
S <- 2381
library(timeDate)
# Lets work in your environment:
getRmetricsOptions("myFinCenter")
setRmetricsOptions(myFinCenter = "America/New_York")
# define a sequence of days with timeSequence
t1 <- timeSequence(from = "2017-03-16", to = "2017-09-29")
# Define a calendar for your exchange (use an available one as a template, e.g.
holidayNYSE)
# subindex the sequence with isBizday using your calendar as an argument
holidayNYSE(2017)
isBizday(t1, holidayNYSE())
t2 <- t1[isBizday(t1, holidayNYSE(2017))]
T <- length(t2)/252
q_m <- -log(PVF/S)/T
r_m <- log(disc)/(-T)
polya <- function(x){
1/2 + sign(x)/2* sqrt(1- exp(-2*x^2/pi))
}
impVolC <- function(callM, K, T, F, r){
y <- log(F/K)
alpha <- callM/(K*exp(-r*T))
R <- 2*alpha - exp(y) + 1
A <- (exp((1 - 2/pi)*y) - exp(-(1 - 2/pi)*y))^2
B <- 4*(exp(2/pi*y) + exp(-2/pi*y)) -
2*exp(-y)*(exp((1-2/pi)*y)+exp(-(1-2/pi)*y))*(exp(2*y) + 1 - R^2)
C <- exp(-2*y)*(R^2 - (exp(y) -1)^2)*((exp(y) + 1)^2 - R^2)
beta <- (2*C)/(B + sqrt(B^2 + 4*A*C))
gamma <- -pi/2*log(beta)
if(y >= 0){
call0 <- K*exp(-r*T)*(exp(y)*polya(sqrt(2*y)) - 0.5)
sig <- (sqrt(gamma + y) + ifelse(callM <= call0, -1, 1) * sqrt(gamma -
y))/sqrt(T)
}else{
call0 <- K*exp(-r*T)*(exp(y)/2 - polya(-sqrt(-2*y)))
sig <- (ifelse(callM <= call0, -1, 1)*sqrt(gamma + y) + sqrt(gamma -
y))/sqrt(T)
}
sig
}
F <- PVF*exp(r_m*T)
sigV <- rep(0, length(call))
for(i in 1:length(call)){
sigV[i] <- impVolC(callM = call[i], K = df$Strike[i], T = T, F = F, r = r_m)
}
> On Sep 20, 2018, at 1:56 PM, MacQueen, Don <macque...@llnl.gov> wrote:
>
> In addition to what the other said, if callM is a vector then an expression
> of the form
> if (callM <= call0)
> is inappropriate. Objects inside the parentheses of if() should have
> length one. For example,
>
>> if (1:5 < 3) 'a' else 'b'
> [1] "a"
> Warning message:
> In if (1:5 < 3) "a" else "b" :
> the condition has length > 1 and only the first element will be used
>
>
> instead of what you have:
> if(callM <= call0){
> sig <- 1/sqrt(T)*(sqrt(gamma + y) - sqrt(gamma - y))
> }else{
> sig <- 1/sqrt(T)*(sqrt(gamma + y) + sqrt(gamma - y))
> }
>
> Here are a couple of (untested) possibilities:
>
> M.gt.0 <- callM > call0
> sig <- 1/sqrt(T)*(sqrt(gamma + y) - sqrt(gamma - y))
> sig[M.gt.0] <- (1/sqrt(T)*(sqrt(gamma + y) + sqrt(gamma - y)))[M.gt.0]
>
> or
>
> sig <- 1/sqrt(T)*(sqrt(gamma + y) + ifelse(callM <= call0, -1, 1) *
> sqrt(gamma - y))
>
> incidentally, I would write
> sig <- (sqrt(gamma + y) - sqrt(gamma - y))/sqrt(T)
> instead of
> sig <- 1/sqrt(T)*(sqrt(gamma + y) - sqrt(gamma - y))
>
> --
> Don MacQueen
> Lawrence Livermore National Laboratory
> 7000 East Ave., L-627
> Livermore, CA 94550
> 925-423-1062
> Lab cell 925-724-7509
>
>
>
> On 9/20/18, 8:08 AM, "R-help on behalf of Lynette Chang"
> <r-help-boun...@r-project.org on behalf of momtoo...@gmail.com> wrote:
>
> Hello everyone,
>
> I’ve a function with five input argument and one output number.
> impVolC <- function(callM, K, T, F, r)
>
> I hope this function can take five vectors as input, then return one
> vector as output. My vectorization ran into problems with the nested if-else
> operation. As a result, I have to write another for loop to call this
> function. Can anyone suggest some methods to overcome it? I put my code
> below, thanks.
>
> impVolC <- function(callM, K, T, F, r){
>
>
> if(y >= 0){
> call0 <- K*exp(-r*T)*(exp(y)*polya(sqrt(2*y)) - 0.5)
> if(callM <= call0){
> sig <- 1/sqrt(T)*(sqrt(gamma + y) - sqrt(gamma - y))
> }else{
> sig <- 1/sqrt(T)*(sqrt(gamma + y) + sqrt(gamma - y))
> }
> }else{
> call0 <- K*exp(-r*T)*(exp(y)/2 - polya(-sqrt(-2*y)))
> if(callM <= call0){
> sig <- 1/sqrt(T)*(-sqrt(gamma + y) + sqrt(gamma - y))
> }else{
> sig <- 1/sqrt(T)*(sqrt(gamma + y) + sqrt(gamma - y))
> }
> }
> sig
> }
>
> for(i in 1:length(call)){
> sigV[i] <- impVolC(callM = call[i], K = df$Strike[i], T = T, F = F, r =
> r_m)
> }
>
> ______________________________________________
> R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide
> http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>
>
______________________________________________
R-help@r-project.org mailing list -- To UNSUBSCRIBE and more, see
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
