आर प्रोग्रामिंग में अस्थिरता सतह ग्राफ पर इंटरपोलेशन फिक्सिंग

Question

यह स्क्रिप्ट नीचे याहू डेटा को क्वांटमोड में एक फ़ंक्शन के माध्यम से खींचती है, फिर आरजीएल लाइब्रेरी के साथ एक 3 डी ग्राफ को फोरमेट करने के लिए डेटा को मालिश करता है, संलग्न डेटा को दिखाने के लिए एक ggplot है जिसे मैं कोशिश कर रहा हूं अलग लाइन geoms में एक सतह बनाने के लिए। मुद्दा यह है कि 3 डी ग्राफ बहुत बदसूरत लग रहा है और फ्रंट महीने की समाप्ति पर सीमित मात्रा में अंक की वजह से कटौती करता है .. क्या कोई मुझे बता सकता है कि यहां क्या हो रहा है, मैं इसे ठीक करने के लिए क्या कर सकता हूं .. क्या मुझे चिकनी करने की ज़रूरत है प्रत्येक समाप्ति की रेखा तब interpolate .... ?? 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'))