R 프로그래밍에서 변동성 표면 그래프에 고정 보간

Question

이 스크립트는 quantmod의 함수를 통해 yahoo 데이터를 가져온 다음 RGA 라이브러리가있는 3D 그래프를 게시하기 위해 데이터를 마사지합니다. 첨부 된 ggplot은 내가 시도하는 데이터를 표시합니다. 별도의 라인 기하 구조로 표면을 생성합니다. 문제는 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 

Answer 1

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)) 

당신은 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'))