Probability1 - 1 year ago 93
R Question

R: Calculating IV using Black-Scholes and bisection method, loop refusing to work

I have my Black-Scholes function and my bisection model for call options with data from a CSV. It appears to be getting stuck in the inner loop because it stays above the tolerance. My Black-Scholes does calculate accurately and I am using the average of bid and ask for the market price instead of the actual price of the option. After working on this for hours, maybe I am just missing something obvious.

``````########################################################################
#Black-Scholes-Merton Call
bsmCall <- function(S, K, M, sig, r) {
yrTime=(M/252)
d1 <- (log(S/K)+(r+(sig^2/2))*(yrTime))/(sig*(sqrt(yrTime)))
d2 <- d1-sig*(sqrt(yrTime))
C <- (S*(pnorm(d1)))-((pnorm(d2))*K*(exp(-r*yrTime)))
return(C)
}
########################################################################

myData <- myData[,2:24]   #omit first column

####### start bisection method of CALLS and put IV in database #######
i <- 1    # reset counter
tol <- 0.000001   #tolerance

while(i <= nrow(myData)) {
if((myData[i,5] != 0) & (myData[i,6] != 0)) {
volLower <- .0001    #will need to reset with each iteration
volUpper <- 1         #will need to reset with each iteration
volMid <- (volLower + volUpper) / 2   #will need to reset with each iteration

while(abs(bsmCall(as.numeric(as.character(myData[i,17])),as.numeric(as.character(myData[i,1])),as.numeric(as.character(myData[i,22])),volMid,as.numeric(as.character(myData[i,23])))-(as.numeric(as.character(myData[i,5])))) >= tol) {
if((bsmCall(as.numeric(as.character(myData[i,17])),as.numeric(as.character(myData[i,1])),as.numeric(as.character(myData[i,22])),volMid,as.numeric(as.character(myData[i,23])))-(as.numeric(as.character(myData[i,5])))) < 0) {
volLower <- volMid
volMid <- (volUpper + volMid)/2
} else {
volUpper <- volMid
volMid <- (volLower + volMid)/2
}
}
myData[i,8] <- volMid
} else { myData[i,8] <- 0 }
i=i+1
}
``````

The problem is here:

``````while(abs(bsmCall(as.numeric(as.character(myData[i,17])),
as.numeric(as.character(myData[i,1])),
as.numeric(as.character(myData[i,22])),
volMid,
as.numeric(as.character(myData[i,23])))-(as.numeric(as.character(myData[i,5])))) >= tol)
``````

You're using a `while` loop on a condition that, if true, is always true. It's an infinite loop. On your first row of data this problem is encountered.

How to fix this error is specific to your use case, but if you just change `while` to `if` you'll see the loop complete immediately.

You asked about the bisection method. There are a few in packages and here's another from here:

``````bisect <- function(fn, lower, upper, tol=1.e-07, ...) {
f.lo <- fn(lower, ...)
f.hi <- fn(upper, ...)
feval <- 2

if (f.lo * f.hi > 0) stop("Root is not bracketed in the specified interval
\n")
chg <- upper - lower

while (abs(chg) > tol) {
x.new <- (lower + upper) / 2
f.new <- fn(x.new, ...)
if (abs(f.new) <= tol) break
if (f.lo * f.new < 0) upper <- x.new
if (f.hi * f.new < 0) lower <- x.new
chg <- upper - lower
feval <- feval + 1
}
list(x = x.new, value = f.new, fevals=feval)
}

# An example
fn1 <- function(x, a) {
exp(-x) - a*x
}

bisect(fn1, 0, 2, a=1)

bisect(fn1, 0, 2, a=2)
``````

Recursive version:

``````bisectMatt <- function(fn, lo, hi, tol = 1e-7, ...) {

flo <- fn(lo, ...)
fhi <- fn(hi, ...)

if(flo * fhi > 0)
stop("root is not bracketed by lo and hi")

mid <- (lo + hi) / 2
fmid <- fn(mid, ...)
if(abs(fmid) <= tol || abs(hi-lo) <= tol)
return(mid)

if(fmid * fhi > 0)
return(bisectMatt(fn, lo, mid, tol, ...))

return(bisectMatt(fn, mid, hi, tol, ...))
}
``````
Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download