8

下面的脚本通过 quantmod 中的函数提取 yahoo 数据，然后使用 RGL 库处理数据以形成 3D 图形，附加的是一个 ggplot 以显示我正在尝试用单独的线 geoms 创建表面的数据。问题是 3D 图表看起来非常难看并且由于前一个月到期的积分数量有限而被切割..谁能告诉我这里发生了什么，我能做些什么来解决这个问题..我需要平滑吗每个到期的线然后插值.... ?? volsurface http://img15.imageshack.us/img15/7338/surface.png ggplot2_smile http://img402.imageshack.us/img402/1272/volatilitysmilegoog.png

library(RQuantLib)
library(quantmod)
library(rgl)
library(akima)
library(ggplot2)
library(plyr)

GetIV <- function(type, value,
                  underlying, strike,dividendYield, riskFreeRate, maturity, volatility,
                  timeSteps=150, gridPoints=151) {

    AmericanOptionImpliedVolatility(type, value,
                                    underlying, strike,dividendYield, riskFreeRate, maturity, volatility,
                                    timeSteps=150, gridPoints=151)$impliedVol
}


GetDelta <- function(type, underlying, strike,
                     dividendYield, riskFreeRate, maturity, volatility, 
                     timeSteps=150, gridPoints=149, engine="CrankNicolson") {

    AmericanOption(type,underlying, strike, dividendYield, riskFreeRate, maturity, volatility,
                   timeSteps=150, gridPoints=149, engine="CrankNicolson")$delta
}
# set what symbol you want vol surface for
underlying <- 'GOOG'
# set what your volatility forcast or assumption is
volforcast <- .25
# Get symbols current price
underlying.price <- getQuote(underlying,what=yahooQF("Last Trade (Price Only)"))$Last

OC <- getOptionChain(underlying, NULL)
#check data
head(OC)
lputs <- lapply(OC, FUN = function(x) x$puts[grep("[A-Z]\\d{6}[CP]\\d{8}$", rownames(x$puts)), ])
head(lputs) #check for NA values, yahoo returns all NA values sometimes
puts <- do.call('rbind', lputs )
#check data
head(puts,5)

symbols <- as.vector(unlist(lapply(lputs, rownames)))
expiries <- unlist(lapply(symbols, FUN = function(x) regmatches(x=x, regexpr('[0-9]{6}', x) )))
puts$maturity <- as.numeric((as.Date(expiries, "%y%m%d") - Sys.Date())/365)

puts$IV <- mapply(GetIV, value = puts$Ask, strike = puts$Strike, maturity = puts$maturity,
                  MoreArgs= list(type='put', underlying= underlying.price,
                                 dividendYield=0, riskFreeRate = 0.01,  
                                 volatility = volforcast), SIMPLIFY=TRUE)

puts$delta <- mapply(GetDelta, strike =  puts$Strike, volatility = puts$IV,
                     maturity = puts$maturity, MoreArgs= list(type='put', 
                                                              underlying=underlying.price, dividendYield=0, 
                                                              riskFreeRate = 0.01 ), SIMPLIFY=TRUE)

# subset out itm puts
puts <- subset(puts, delta < -.09 & delta > -.5 )

expiries.formated <- format(as.Date(levels(factor(expiries)), format = '%y%m%d'), "%B %d, %Y")

fractionofyear.levels <- levels(factor(puts$maturity))

xyz <- with(puts, interp(x=maturity, y=delta*100, z=IV*100, 
                         xo=sort(unique(maturity)), extrap=FALSE ))

with(xyz, persp3d(x,y,z, col=heat.colors(length(z))[rank(z)], xlab='maturity', 
                  ylab='delta', zlab='IV', main='IV Surface'))

putsplot <- ggplot(puts, aes(delta, IV, group = factor(maturity), color = factor(maturity))) +
    labs(x = "Delta", y = "Implied Volatilty", title="Volatility Smile", color = "GooG \nExpiration") +
    scale_colour_discrete( breaks=c(fractionofyear.levels),
                           labels=c(expiries.formated)) + 
    geom_line() +
    geom_point()

putsplot
4

1 回答 1

3

该akima软件包正是您所需要的，但我认为您需要减少y 轴（delta变量）中插值点的数量。您现在设置的方式使用默认的 40 点网格。

# No interpolation on x-axis, but uses the default 40 point grid on the y-axis
xyz <- with(puts, interp(x=maturity, y=delta*100, z=IV*100, 
            xo=sort(unique(maturity)), extrap=FALSE ))
# By setting to use less points, it will "stretch" the surface over those points.
xyz <- with(puts, interp(x=maturity, y=delta*100, z=IV*100, 
            xo=sort(unique(maturity)), 
            yo=seq(min(delta*100), max(delta*100), length = 15), extrap=FALSE ))

y 轴平滑的表面

您可以使用seq函数中的长度变量来获得不同级别的平滑度。

我仍然不完全明白你想要什么，但也许你想平滑maturity？这就是它的样子：

# This smooths just by x.
xyz <- with(puts, interp(x=maturity, y=delta*100, z=IV*100, 
            xo=seq(min(maturity), max(maturity), length = 5), 
            , extrap=FALSE ))

with(xyz, persp3d(x,y,z, col=heat.colors(length(z))[rank(z)], xlab='maturity', 
                  ylab='delta', zlab='IV', main='IV Surface'))

在此处输入图像描述

于 2013-05-11T06:55:27.517 回答