## RQuantLib function sabrSwaption
##
## Copyright (C) 2005 Dominick Samperi
## Copyright (C) 2007 - 2015 Dirk Eddelbuettel
## Copyright (C) 2016 Terry Leitch and Dirk Eddelbuettel
##
## This file is part of RQuantLib.
##
## RQuantLib is free software: you can redistribute it and/or modify
## it under the terms of the GNU General Public License as published by
## the Free Software Foundation, either version 2 of the License, or
## (at your option) any later version.
##
## RQuantLib is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with RQuantLib. If not, see <http://www.gnu.org/licenses/>.
SabrSwaption <- function(params,
ts,volCubeDF,
legparams=list(dayCounter="Thirty360",
fixFreq="Annual",
floatFreq="Semiannual"),
tsUp01=NA,tsDn01=NA,vega=FALSE) {
UseMethod("SabrSwaption")
}
SabrSwaption.default <- function(params,
ts, volCubeDF,
legparams=list(dayCounter="Thirty360",
fixFreq="Annual",
floatFreq="Semiannual"),
tsUp01=NA,tsDn01=NA,vega=FALSE) {
# Check that params list names
if(is.null(params$startDate)){
params$startDate=advance("UnitedStates",params$tradeDate, 1, 3)
warning("swaption start date not set, defaulting to 1 year from trade date using US calendar")
}
if(is.null(params$expiryDate)){
params$expiryDate=params$startDate
warning("swaption expiry date not set, defaulting to 1 year from trade date using US calendar")
}
if(is.null(params$maturity)){
params$maturity=advance("UnitedStates",params$startDate, 5, 3)
warning("swaption maturity not set, defaulting to 5 years from startDate using US calendar")
}
volCube=volDF2CubeK(params,volCubeDF)
if(vega){
volCubeDF$LogNormalVol=volCubeDF$LogNormalVol+.01
volCubeUp=volDF2CubeK(params,volCubeDF)
}
swapTenors=volCube$tenors
if (!is.list(params) || length(params) == 0) {
stop("The params parameter must be a non-empty list", call.=FALSE)
}
swaptionMaturities=volCube$expiries
##reshape dataframe to fit QL call
vc=volDF2CubeK(params,volCubeDF)
matYears=as.numeric(params$maturity-params$tradeDate)/365
expYears=as.numeric(params$expiryDate-params$tradeDate)/365
if (inherits(ts, "DiscountCurve")) {
matchlegs<-matchParams(legparams)
val <- sabrengine(params, matchlegs, c(ts$table$date), ts$table$zeroRates,
volCube$expiries,volCube$tenors,volCube$atmVol,volCube$strikes,volCube$smirk)
if(vega){
valUp <- sabrengine(params, matchlegs, c(ts$table$date), ts$table$zeroRates,
volCubeUp$expiries,volCubeUp$tenors,volCubeUp$atmVol,volCubeUp$strikes,volCubeUp$smirk)
val$payVega=valUp$pay-val$pay
val$rcvVega=valUp$rcv-val$rcv
if(anyNA(tsUp01)){
}else{
valTsUp <- sabrengine(params, matchlegs, c(tsUp01$table$date), tsUp01$table$zeroRates,
volCube$expiries,volCube$tenors,volCube$atmVol,volCube$strikes,volCube$smirk)
val$payDV01=valTsUp$pay-val$pay
val$rcvDV01=valTsUp$rcv-val$rcv
if(anyNA(tsDn01)){
} else{
valTsDn <- sabrengine(params, matchlegs, c(tsDn01$table$date), tsDn01$table$zeroRates,
volCube$expiries,volCube$tenors,volCube$atmVol,volCube$strikes,volCube$smirk)
val$payCnvx=(valTsUp$pay+valTsDn$pay-2*val$pay)/2
val$rcvCnvx=(valTsUp$rcv+valTsDn$rcv-2*val$rcv)/2
}
}
}
} else{
stop("DiscountCurve class term structure required", call.=FALSE)
}
val$params=params
val$atmRate=as.numeric(val$atmRate)
class(val) <- "SabrSwaption"
summary(val)
val
}
volDF2CubeK <- function(params, tbl, source = "CME") {
strikes <- levels(tbl$Spread)<-c(-200,-150,-100,-75,-50,-25,0,25,50,75,100,150,200)
matYears <- as.numeric(params$maturity-params$tradeDate)/365
expYears <- as.numeric(params$expiryDate-params$tradeDate)/365
expLvl <- c( "1M","3M","6M","1Y","2Y","3Y","4Y", "5Y", "6Y", "7Y", "8Y", "9Y","10Y")
tbl$Expiry <- factor(tbl$Expiry, levels <- expLvl)
expiries <- c(1/12,.25,.5,1,2,3,4,5,6,7,8,9,10)
tenorLvl <- c( "1Y", "2Y", "5Y", "10Y","15Y","20Y","30Y")
tbl$Tenor <- factor(tbl$Tenor, levels = tenorLvl)
tenors <- c(1,2,5,10,15,20,30)
tenorIDX <- max(findInterval(matYears-expYears,tenors),1)
tenorIDX <- min(tenorIDX,length(tenors)-3)
expiryIDX <- findInterval(expYears,expiries)
expiryIDX <- min(expiryIDX,length(expiries)-3)
strikeIDX <- 1
expire <- expLvl[expiryIDX]
tenor <- tenorLvl[tenorIDX]
for(strike in levels(tbl$Spread)){
if(!is.na(tbl[tbl$Expiry==expire & tbl$Spread==strike &tbl$Tenor==tenor,]$LogNormalVol))break;
strikeIDX <- strikeIDX+1
}
strikes <- strikes[strikeIDX:length(strikes)]
expLvl <- expLvl[expiryIDX:length(expLvl)]
expiries <- expiries[expiryIDX:length(expiries)]
tenorLvl <- tenorLvl[tenorIDX:length(tenorLvl)]
tenors <- tenors[tenorIDX:length(tenors)]
tbl <- tbl[tbl$Expiry%in%expLvl,]
tbl <- tbl[tbl$Tenor%in%tenorLvl,]
tbl <- tbl[tbl$Spread%in%strikes,]
tbl <- tbl[with(tbl,order(Expiry,Tenor,Spread)),]
tbl3 <- tbl[tbl$Spread==0,]
# atm vol matrix
#atmMat=acast(tbl3,Expiry~Tenor,value.var = "LogNormalVol")
atmMat=matrix(data=NA,nrow=length(expLvl),ncol=length(tenorLvl),dimnames=list(expLvl,tenorLvl))
for(i in 1:length(expLvl)){
for(j in 1:length(tenorLvl)){
atmMat[i,j]=tbl[tbl$Expiry==expLvl[i]& tbl$Tenor==tenorLvl[j] & tbl$Spread==0,]$LogNormalVol
}
}
smirk=matrix(ncol=length(strikes),nrow=length(expLvl)*length(tenorLvl))
#tmp3=acast(tbl,Expiry~Tenor~Spread,value.var="LogNormalVol")
k=0
for(i in 1:length(expLvl)){
for(j in 1:length(tenorLvl)){
k=k+1
for(n in 1:length(strikes)){
#smirk[k,]=tmp3[i,j,]-tmp3[i,j,"0"]
smirk[k,n]=tbl[tbl$Expiry==expLvl[i]& tbl$Tenor==tenorLvl[j] & tbl$Spread==strikes[n],]$LogNormalVol -
tbl[tbl$Expiry==expLvl[i]& tbl$Tenor==tenorLvl[j] & tbl$Spread==0,]$LogNormalVol
}
}
}
smirk <- na.spline(smirk,method="natural")
tmp <- list(atmVol=atmMat,tenors=tenors,expiries=expiries,smirk=smirk,strikes=strikes/10000)
class(tmp) <- "volcube"
return(tmp)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.