RQuantLib/ 0000755 0001762 0000144 00000000000 14652456451 012127 5 ustar ligges users RQuantLib/tests/ 0000755 0001762 0000144 00000000000 14652452404 013263 5 ustar ligges users RQuantLib/tests/RQuantlib.R 0000644 0001762 0000144 00000020145 13403306333 015301 0 ustar ligges users
stopifnot(require(RQuantLib))
## values from Quantlib's test-suite
## Reference: Haug, Option Pricing Formulas, McGraw-Hill, 1998
##
## and generally sourced from the code in the test-suite/
## directory of the QuantLib distribution
## europeanoption.cpp: call value == 2.1334
print(EuropeanOption("call", underlying=60, strike=65, div=0, riskFree=0.08,
maturity=0.25, vol=0.3), digits=5)
## europeanoption.cpp: put value == 2.4648
print(EuropeanOption("put", underlying=100, strike=95, div=0.05, riskFree=0.1,
maturity=0.5, vol=0.2), digits=5)
## europeanoption.cpp: call delta == 0.5946
print(EuropeanOption("call", underlying=105, strike=100,div=0.1,riskFree=0.1,
maturity=0.5, vol=0.36), digits=4)
## europeanoption.cpp: put delta == -0.3566
print(EuropeanOption("put", underlying=105, strike=100,div=0.1,riskFree=0.1,
maturity=0.5, vol=0.36), digits=4)
## europeanoption.cpp: call gamma == 0.0278
print(EuropeanOption("call", underlying=55, strike=60,div=0.0,riskFree=0.1,
maturity=0.75, vol=0.30), digits=4)
## europeanoption.cpp: put gamma == 0.0278
print(EuropeanOption("put", underlying=55, strike=60,div=0.0,riskFree=0.1,
maturity=0.75, vol=0.30), digits=4)
## europeanoption.cpp: call vega == 18.9358
print(EuropeanOption("call", underlying=55, strike=60,div=0.0,riskFree=0.1,
maturity=0.75, vol=0.30), digits=4)
## europeanoption.cpp: put vega == 18.9358
print(EuropeanOption("put", underlying=55, strike=60,div=0.0,riskFree=0.1,
maturity=0.75, vol=0.30), digits=4)
## americanoption.cpp: call value == 10.0089 -- we show 10.00606
print(AmericanOption("call", underlying=110, strike=100, div=0.1, riskFree=0.1,
maturity=0.1, vol=0.15), digits=5)
## americanoption.cpp: put value == 0.3159
print(AmericanOption("call", underlying=90, strike=100, div=0.1, riskFree=0.1,
maturity=0.1, vol=0.25), digits=5)
# Discrete dividend
## europeanoption.cpp: call value == 3.67
## Reference pg. 253 - Hull 5th ed Exercise 12.8 - From QuantLib tests
print(EuropeanOption("call", underlying=40, strike=40, div=0, riskFree=0.09,
maturity=0.5, vol=0.3,
discreteDividends = c(0.5, 0.5),
discreteDividendsTimeUntil = c(2/12, 5/12)), digits=5)
## americanoption.cpp: call value == 3.72 (Hull) -- we show 3.75
## Reference p. 256 - Hull 5th ed. Exercise 12.9 using (flawed) Roll, Geske, Whaley formula
print(AmericanOption("call", underlying=40, strike=40, div=0, riskFree=0.09,
maturity=0.5, vol=0.3,
engine = "CrankNicolson",
discreteDividends = c(0.5, 0.5),
discreteDividendsTimeUntil = c(2/12, 5/12)), digits=5)
## barrier: down and out call == 9.0246
print(BarrierOption("downout", barrier=95, rebate=3, type="call",
strike=90, underlying=100, div=0.04, riskF=0.08,
mat=0.5, vol=0.25), digits=4)
## barrier: down and in call == 7.7627
print(BarrierOption("downin", barrier=95, rebate=3, type="call",
strike=90, underlying=100, div=0.04, riskF=0.08,
mat=0.5, vol=0.25), digits=4)
## binary aka digital: put == 2.6710
print(BinaryOption(binType="cash", type="put", excType="european",
strike=80, underl=100, div=0.06, r=0.06,
mat=0.75, vol=0.35, cash=10), digits=4)
## asianoption.cpp: put == 4.6922 (from testAnalyticContinuousGeometricAveragePrice())
print( AsianOption("geometric", "put", underlying=80, strike=85, div=-0.03, riskFree=0.05, maturity=0.25, vol=0.2))
#.onWindows <- .Platform$OS.type == "windows"
## simple call with unnamed parameters
bond <- list(faceAmount=100,issueDate=as.Date("2004-11-30"),
maturityDate=as.Date("2008-11-30"), redemption=100 )
dateparams <-list(settlementDays=1, calendar="UnitedStates/GovernmentBond", businessDayConvention='Unadjusted')
discountCurve.param <- list(tradeDate=as.Date('2002-2-15'),
settleDate=as.Date('2002-2-15'),
dt=0.25,
interpWhat='discount', interpHow='loglinear')
discountCurve <- DiscountCurve(discountCurve.param, list(flat=0.05))
ZeroCouponBond(bond, discountCurve, dateparams)
## bond.cpp: examples from Fixed Income page of Matlab
ZeroYield(95, 100, as.Date("1993-6-24"), as.Date("1993-11-1"))
## bond.cpp: test theoretical price of bond by its yield
ZeroPriceByYield(0.1478, 100, as.Date("1993-6-24"), as.Date("1993-11-1"))
## bond.cpp: test theoretical yield of a fixed rate bond, = 0.0307
FixedRateBondYield(,99.282, 100000, as.Date("2004-11-30"), as.Date("2008-11-30"), 3, , c(0.02875), , , , ,as.Date("2004-11-30"))
## bond.cpp: test theoretical price of a fixed rate bond = 99.2708
FixedRateBondPriceByYield(,0.0307, 100000, as.Date("2004-11-30"), as.Date("2008-11-30"), 3, , c(0.02875), , , , ,as.Date("2004-11-30"))
## bond.cpp
## Simple call with a flat curve
bond <- list(settlementDays=1,
issueDate=as.Date("2004-11-30"),
faceAmount=100,
dayCounter='Thirty360',
paymentConvention='Unadjusted')
schedule <- list(effectiveDate=as.Date("2004-11-30"),
maturityDate=as.Date("2008-11-30"),
period='Semiannual',
calendar='UnitedStates/GovernmentBond',
businessDayConvention='Unadjusted',
terminationDateConvention='Unadjusted',
dateGeneration='Forward',
endOfMonth=1)
calc=list(dayCounter='Actual360',
compounding='Compounded',
freq='Annual',
durationType='Modified')
coupon.rate <- c(0.02875)
params <- list(tradeDate=as.Date('2002-2-15'),
settleDate=as.Date('2002-2-19'),
dt=.25,
interpWhat="discount",
interpHow="loglinear")
discountCurve.flat <- DiscountCurve(params, list(flat=0.05))
FixedRateBond(bond,
coupon.rate,
schedule,
calc,
discountCurve=discountCurve.flat)
## Same bond calculated from yield rather than from the discount curve
yield <- 0.02
FixedRateBond(bond,
coupon.rate,
schedule,
calc,
yield=yield)
#same example with clean price
price <- 103.31
FixedRateBond(bond,
coupon.rate,
schedule,
calc,
price = price)
## bond.cpp FloatingRateBond, following test-suite/bonds.cpp
bond <- list(faceAmount=100, issueDate=as.Date("2004-11-30"),
maturityDate=as.Date("2008-11-30"), redemption=100,
effectiveDate=as.Date("2004-11-30"))
dateparams <- list(settlementDays=1, calendar="UnitedStates/GovernmentBond",
dayCounter = 'ActualActual', period=2,
businessDayConvention = 1, terminationDateConvention=1,
dateGeneration=0, endOfMonth=0, fixingDays = 1)
gearings <- spreads <- caps <- floors <- vector()
params <- list(tradeDate=as.Date('2002-2-15'),
settleDate=as.Date('2002-2-19'),
dt=.25,
interpWhat="discount",
interpHow="loglinear")
tsQuotes <- list(d1w =0.0382,
d1m =0.0372,
fut1=96.2875,
fut2=96.7875,
fut3=96.9875,
fut4=96.6875,
fut5=96.4875,
fut6=96.3875,
fut7=96.2875,
fut8=96.0875,
s3y =0.0398,
s5y =0.0443,
s10y =0.05165,
s15y =0.055175)
## when both discount and libor curves are flat.
discountCurve.flat <- DiscountCurve(params, list(flat=0.05))
termstructure <- DiscountCurve(params, list(flat=0.03))
iborIndex.params <- list(type="USDLibor", length=6,
inTermOf="Month", term=termstructure)
FloatingRateBond(bond, gearings, spreads, caps, floors,
iborIndex.params, discountCurve.flat, dateparams)
RQuantLib/tests/tinytest.R 0000644 0001762 0000144 00000001034 13564352402 015265 0 ustar ligges users
if (requireNamespace("tinytest", quietly=TRUE) &&
utils::packageVersion("tinytest") >= "1.0.0") {
## Set a seed to make the test deterministic
set.seed(42)
## R makes us to this
Sys.setenv("R_TESTS"="")
## there are several more granular ways to test files in a tinytest directory,
## see its package vignette; tests can also run once the package is installed
## using the same command `test_package(pkgName)`, or by director or file
tinytest::test_package("RQuantLib", ncpu=getOption("Ncpus", 1))
}
RQuantLib/MD5 0000644 0001762 0000144 00000013237 14652456451 012445 0 ustar ligges users ae13374af476125fbf050f35ffd803a5 *ChangeLog
462fe40153690a6f7fbebb310aff711f *DESCRIPTION
6f2492e23ee67e4c94cd14c782335f58 *NAMESPACE
74bdca37b6928f20029a88e4f3182d11 *R/RcppExports.R
8bae9e10a0e0a48dd0b91bb6a0bde18d *R/affine.R
d1a8bb78523a6b3825293784e37f3844 *R/arrays.R
aa79aeacc8d63ddb3ac33b6706c05e1e *R/asian.R
29e7581085d455c1e624b5a42b3b955d *R/bermudan.R
688fbc14f3e3150e1e524f57b58a07fd *R/bond.R
199d4fe297a35feaa479c65d0d4eeaa4 *R/calendars.R
c946fbb142fc1ad588319ecf5b3b6fba *R/datasets.R
a0a4d7aa07a16c88bfcb94caf171b9b3 *R/dayCounter.R
b573f804569873ce3c288f1c2c09a5d6 *R/discount.R
b79175a852abf36508c1fe7c8be9546b *R/hullWhiteCalibration.R
db5f0c220ccb7a54c72f7343a3279457 *R/implied.R
03c5562d493d8c2a9577aa3d3132d56d *R/inline.R
57bb1ee8b9bc6931658c5f4ef95f70e3 *R/mod.R
54ac323ca76afcebd9299156d48ad279 *R/option.R
3b7caab9ae86f5f083e58f68a3e109ba *R/sabr.R
1820845115c19f810eb0ccc279e4cce2 *R/schedule.R
cd95d1bdf925936fea0e4652d8d5b34a *R/zzz.R
b550c98423ce37e2f03b3daae68997cb *README.md
0b4e9a09b64bef80f5a626b72b29df56 *cleanup
0be7615078057fcfaf870f4a229835a0 *configure
6cc452aa22ae578b9c0cb9eecbdff0ce *configure.ac
06ded84c598c7b5fb3d10c910c6512eb *data/tsQuotes.RData
6a360f06dee24a5e101006a6f580a802 *data/vcube.RData
fd060754d818864ca897476ff2b58f16 *demo/00Index
158727f1e40f6b5ad10f228368dc47bb *demo/OptionSurfaces.R
8887075c0be0b9a5ed5368d8b7b5333e *demo/ShinyDiscountCurves.R
2adf2228c562c11831db1d7ee0480cc6 *inst/Boost_LICENSE.TXT
9ec4fa18161b2b46e80c72d97ee60334 *inst/NEWS.Rd
6ce07e1e9679d2c63ff4fe0bece5ad05 *inst/QuantLib_LICENSE.TXT
f4b079613d0dee5843973b30e0b6aa77 *inst/include/RQuantLib.h
791e66a357ffc678d4be05d136ef6880 *inst/include/RQuantLib_RcppExports.h
b44e152e6474102c15d3a93e362061f8 *inst/include/rquantlib_impl.h
d119ab047e65a71a2fd4ead7157f75c0 *inst/include/rquantlib_internal.h
001d1eea5707e1b3369e95ee2165ad74 *inst/include/rquantlib_wrappers.h
11c98a9cc1dbd4604c20ad86cb85fff8 *inst/shiny/DiscountCurve/server.R
397d98cb41922fe368e6f0701d36d1f0 *inst/shiny/DiscountCurve/ui.R
078ee9b3bbaadf65afbfceded0d9d7e9 *inst/shiny/SabrSwaption/README.md
c56b0b08e1ee51334d5c2b76683ce3ec *inst/shiny/SabrSwaption/server.R
f278368b4f4e603e0a936c0c6691fba2 *inst/shiny/SabrSwaption/ui.R
ad9146ee33b853d522f948f4923ec75b *inst/shiny/SabrSwaption/volDF2CubeK.R
d8edd335ab2b7b0727a002c0ddf5cc39 *inst/shiny/SabrSwaption/volcube.csv
ca4e6472c457a1e9ade2b7f87a3a475c *inst/tinytest/cpp/dates.cpp
641daa9e7373fdc1e507e879d655af01 *inst/tinytest/test_businessdayconvention.R
3438bf4439d2f76c5ebb691364406dae *inst/tinytest/test_calendar.R
28ffb91bf505701b3fc021a34183cba5 *inst/tinytest/test_dates.R
78c29ac033586e11d981894f04c36b29 *inst/tinytest/test_options.R
d541dba51ae9fed4b41e7a44714922c1 *inst/tinytest/test_schedule.R
ca0cc805bc7aeef8b5a22fb725432f8a *man/AffineSwaption.Rd
b15996d00af44bb02ca192d6a4dfb9b1 *man/AmericanOption.Rd
f3538238035a035afe0c5a010e8e74af *man/AmericanOptionImpliedVolatility.Rd
7106cd557e531d46b0a943b2743a1a57 *man/AsianOption.Rd
f93917c87e77e516418891783808c9f1 *man/BarrierOption.Rd
cc1ccf7d9a4992ba836ff09e6d790908 *man/BermudanSwaption.Rd
abc0de9601050db8be63664ff6385e7d *man/BinaryOption.Rd
f78397873049ed9f6d8910100b53bb97 *man/BinaryOptionImpliedVolatility.Rd
70b743b4e768d075ae01001b87c0f4bc *man/Bond.Rd
2446c79680df6c0d1044ae8566dbac46 *man/BondUtilities.Rd
7a7ab771e8d58207d57c0bc9e79293ab *man/Calendars.Rd
7d8351caa226d27cc8053c82ba940938 *man/CallableBond.Rd
79c0d19531d8a191bea8cf0fa62c0559 *man/ConvertibleBond.Rd
8608518fe8fd88a8b4bf0d77bbd98f70 *man/DiscountCurve.Rd
1319167b7971cf6e0b6d313bdeabb73d *man/Enum.Rd
45f88424604152ec447dd0b72a34b148 *man/EuropeanOption.Rd
f3b2273829d760d14adf849a434633e3 *man/EuropeanOptionArrays.Rd
bd2d73d7801beeed4480a7043e13a12d *man/EuropeanOptionImpliedVolatility.Rd
492a1def62a4dfa911be1db19d49e6dd *man/FittedBondCurve.Rd
056548b7d93c79a2c435eff1923f4bba *man/FixedRateBond.Rd
6d9a77ad05baedeac2a4b0c479a377f0 *man/FloatingRateBond.Rd
c1f1126ade1121bd416a8d12dc4b1d08 *man/ImpliedVolatility.Rd
bd33272fcb6f5075af9d4eac8543b482 *man/Option.Rd
cebcb30d66543a50b95b4f6ffe008c22 *man/SabrSwaption.Rd
fb2fa47e192132df023291a911cc07c9 *man/Schedule.Rd
8ef46f2f1a4b6a185fcb36c58dc98dec *man/ZeroCouponBond.Rd
465e234c2ac6746c492421cba8c557db *man/getQuantLibCapabilities.Rd
6d445a89d4f35f8fecbd0d29503c9bff *man/getQuantLibVersion.Rd
0abdd3c24763fc0d991155276b2f7577 *man/tsQuotes.Rd
b132afe2925ac2a027e19002d40ed388 *man/vcube.Rd
8870eb3132e96dfcc3d3ed50f223dfd0 *src/Makevars.in
5fe1d42627b6d6101d7bce6e137d2560 *src/Makevars.win
2de8bde482f9d1b1ac169a546f200206 *src/RcppExports.cpp
1daa62867cb7b201cbc5e17a697dd47a *src/affine.cpp
3dc085eccadd5d1de2b50d0f6852ac45 *src/asian.cpp
82491c0d630f617c6f319ee40796f6aa *src/barrier_binary.cpp
5b8f706bc0a4f3b8d864b1cd1d66e839 *src/bermudan.cpp
6b0f60ea3d4fc76eb56df9a1c0ea85d3 *src/bonds.cpp
fe0fe816e4c4bd4d4ec05a1cebb53a11 *src/calendars.cpp
0a9e2d427d5545a34d79befa152c073c *src/curves.cpp
b467ede776a5f35074b1b13011686dbe *src/dates.cpp
99eb924b6326ccef0f2d4e17b28e7790 *src/daycounter.cpp
5cbf1e336e97a65e20fdd61dc27aee44 *src/deprecated/rquantlib.h
d5d3c28120084a646790392999881490 *src/discount.cpp
69b23f4885012af746ae2648db7da8cb *src/hullwhite.cpp
8814823b6a4258bc9e62c9da49420512 *src/implieds.cpp
30fc5d704106520e394d42a520045782 *src/modules.cpp
2a6ef65f3553cb2a38e2bfe5b8da2c20 *src/sabr.cpp
5c3a8515fe3237dc4b6e0d05e0424ea5 *src/schedule.cpp
4c50c510ac926e36868d69169de0b997 *src/utils.cpp
aef421e590bcc7cbe2a195b23cc04c00 *src/vanilla.cpp
406bd3df1749ed959f1c3cf1762e4561 *src/zero.cpp
109f1aa5994f65aec7f0a6ee5cfedfc3 *tests/RQuantlib.R
8ec30eb98b0069708f04d87ef146fed0 *tests/tinytest.R
0e2ae09ae946a03f6e132b9aff0442ad *tools/build_RQuantLib.sh
95431c5a45d52d2d0ce34ab19ee95309 *tools/winlibs.R
RQuantLib/R/ 0000755 0001762 0000144 00000000000 14652452403 012321 5 ustar ligges users RQuantLib/R/sabr.R 0000644 0001762 0000144 00000015737 14234647620 013413 0 ustar ligges users ## 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 .
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)
}
RQuantLib/R/RcppExports.R 0000644 0001762 0000144 00000032354 14652452403 014744 0 ustar ligges users # Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
affineWithRebuiltCurveEngine <- function(rparam, legparams, dateVec, zeroVec, swaptionMat, swapLengths, swaptionVols) {
.Call(`_RQuantLib_affineWithRebuiltCurveEngine`, rparam, legparams, dateVec, zeroVec, swaptionMat, swapLengths, swaptionVols)
}
asianOptionEngine <- function(averageType, type, underlying, strike, dividendYield, riskFreeRate, maturity, volatility, first, length, fixings) {
.Call(`_RQuantLib_asianOptionEngine`, averageType, type, underlying, strike, dividendYield, riskFreeRate, maturity, volatility, first, length, fixings)
}
binaryOptionEngine <- function(binType, type, excType, underlying, strike, dividendYield, riskFreeRate, maturity, volatility, cashPayoff) {
.Call(`_RQuantLib_binaryOptionEngine`, binType, type, excType, underlying, strike, dividendYield, riskFreeRate, maturity, volatility, cashPayoff)
}
binaryOptionImpliedVolatilityEngine <- function(type, value, underlying, strike, dividendYield, riskFreeRate, maturity, volatility, cashPayoff) {
.Call(`_RQuantLib_binaryOptionImpliedVolatilityEngine`, type, value, underlying, strike, dividendYield, riskFreeRate, maturity, volatility, cashPayoff)
}
barrierOptionEngine <- function(barrType, type, underlying, strike, dividendYield, riskFreeRate, maturity, volatility, barrier, rebate) {
.Call(`_RQuantLib_barrierOptionEngine`, barrType, type, underlying, strike, dividendYield, riskFreeRate, maturity, volatility, barrier, rebate)
}
bermudanFromYieldEngine <- function(rparam, yield, swaptionMat, swapLengths, swaptionVols) {
.Call(`_RQuantLib_bermudanFromYieldEngine`, rparam, yield, swaptionMat, swapLengths, swaptionVols)
}
bermudanWithRebuiltCurveEngine <- function(rparam, dateVec, zeroVec, swaptionMat, swapLengths, swaptionVols) {
.Call(`_RQuantLib_bermudanWithRebuiltCurveEngine`, rparam, dateVec, zeroVec, swaptionMat, swapLengths, swaptionVols)
}
zeroPriceByYieldEngine <- function(yield, faceAmount, dayCounter, frequency, businessDayConvention, compound, maturityDate, issueDate) {
.Call(`_RQuantLib_zeroPriceByYieldEngine`, yield, faceAmount, dayCounter, frequency, businessDayConvention, compound, maturityDate, issueDate)
}
zeroYieldByPriceEngine <- function(price, faceAmount, dayCounter, frequency, businessDayConvention, compound, maturityDate, issueDate) {
.Call(`_RQuantLib_zeroYieldByPriceEngine`, price, faceAmount, dayCounter, frequency, businessDayConvention, compound, maturityDate, issueDate)
}
fixedRateBondYieldByPriceEngine <- function(settlementDays, price, cal, faceAmount, businessDayConvention, compound, redemption, dayCounter, frequency, maturityDate, issueDate, effectiveDate, rates) {
.Call(`_RQuantLib_fixedRateBondYieldByPriceEngine`, settlementDays, price, cal, faceAmount, businessDayConvention, compound, redemption, dayCounter, frequency, maturityDate, issueDate, effectiveDate, rates)
}
fixedRateBondPriceByYieldEngine <- function(settlementDays, yield, cal, faceAmount, businessDayConvention, compound, redemption, dayCounter, frequency, maturityDate, issueDate, effectiveDate, rates) {
.Call(`_RQuantLib_fixedRateBondPriceByYieldEngine`, settlementDays, yield, cal, faceAmount, businessDayConvention, compound, redemption, dayCounter, frequency, maturityDate, issueDate, effectiveDate, rates)
}
FloatBond1 <- function(bond, gearings, caps, spreads, floors, indexparams, index, discountCurve, dateparams) {
.Call(`_RQuantLib_FloatBond1`, bond, gearings, caps, spreads, floors, indexparams, index, discountCurve, dateparams)
}
FloatBond2 <- function(bond, gearings, caps, spreads, floors, indexparams, index_params, index_tsQuotes, index_times, discountCurve, dateparams) {
.Call(`_RQuantLib_FloatBond2`, bond, gearings, caps, spreads, floors, indexparams, index_params, index_tsQuotes, index_times, discountCurve, dateparams)
}
FloatBond3 <- function(bond, gearings, caps, spreads, floors, indexparams, index, disc_params, disc_tsQuotes, disc_times, dateparams) {
.Call(`_RQuantLib_FloatBond3`, bond, gearings, caps, spreads, floors, indexparams, index, disc_params, disc_tsQuotes, disc_times, dateparams)
}
FloatBond4 <- function(bond, gearings, caps, spreads, floors, indexparams, index_params, index_tsQuotes, index_times, disc_params, disc_tsQuotes, disc_times, dateparams) {
.Call(`_RQuantLib_FloatBond4`, bond, gearings, caps, spreads, floors, indexparams, index_params, index_tsQuotes, index_times, disc_params, disc_tsQuotes, disc_times, dateparams)
}
floatingWithRebuiltCurveEngine <- function(bondparams, gearings, spreads, caps, floors, indexparams, iborDateVec, iborzeroVec, dateVec, zeroVec, dateparams) {
.Call(`_RQuantLib_floatingWithRebuiltCurveEngine`, bondparams, gearings, spreads, caps, floors, indexparams, iborDateVec, iborzeroVec, dateVec, zeroVec, dateparams)
}
FixedRateWithYield <- function(bondparam, ratesVec, scheduleparam, calcparam, yield) {
.Call(`_RQuantLib_FixedRateWithYield`, bondparam, ratesVec, scheduleparam, calcparam, yield)
}
FixedRateWithPrice <- function(bondparam, ratesVec, scheduleparam, calcparam, price) {
.Call(`_RQuantLib_FixedRateWithPrice`, bondparam, ratesVec, scheduleparam, calcparam, price)
}
FixedRateWithRebuiltCurve <- function(bondparam, ratesVec, scheduleparam, calcparam, dateVec, zeroVec) {
.Call(`_RQuantLib_FixedRateWithRebuiltCurve`, bondparam, ratesVec, scheduleparam, calcparam, dateVec, zeroVec)
}
ZeroBondWithRebuiltCurve <- function(bond, dateVec, zeroVec, dateparams) {
.Call(`_RQuantLib_ZeroBondWithRebuiltCurve`, bond, dateVec, zeroVec, dateparams)
}
convertibleZeroBondEngine <- function(rparam, processParam, dividendYieldDateVec, dividendYieldZeroVec, rffDateVec, rffZeroVec, dividendScheduleFrame, callabilityScheduleFrame, datemisc) {
.Call(`_RQuantLib_convertibleZeroBondEngine`, rparam, processParam, dividendYieldDateVec, dividendYieldZeroVec, rffDateVec, rffZeroVec, dividendScheduleFrame, callabilityScheduleFrame, datemisc)
}
convertibleFixedBondEngine <- function(rparam, rates, processParam, dividendYieldDateVec, dividendYieldZeroVec, rffDateVec, rffZeroVec, dividendScheduleFrame, callabilityScheduleFrame, datemisc) {
.Call(`_RQuantLib_convertibleFixedBondEngine`, rparam, rates, processParam, dividendYieldDateVec, dividendYieldZeroVec, rffDateVec, rffZeroVec, dividendScheduleFrame, callabilityScheduleFrame, datemisc)
}
convertibleFloatingBondEngine <- function(rparam, processParam, dividendYieldDateVec, dividendYieldZeroVec, rffDateVec, rffZeroVec, iborIndexDateVec, iborIndexZeroVec, iborparams, spreads, dividendScheduleFrame, callabilityScheduleFrame, datemisc) {
.Call(`_RQuantLib_convertibleFloatingBondEngine`, rparam, processParam, dividendYieldDateVec, dividendYieldZeroVec, rffDateVec, rffZeroVec, iborIndexDateVec, iborIndexZeroVec, iborparams, spreads, dividendScheduleFrame, callabilityScheduleFrame, datemisc)
}
callableBondEngine <- function(rparam, hwparam, coupon, callabilityScheduleFrame, datemisc) {
.Call(`_RQuantLib_callableBondEngine`, rparam, hwparam, coupon, callabilityScheduleFrame, datemisc)
}
fittedBondCurveEngine <- function(curveparam, length, coupons, marketQuotes, datemisc) {
.Call(`_RQuantLib_fittedBondCurveEngine`, curveparam, length, coupons, marketQuotes, datemisc)
}
setCalendarContext <- function(calendar, fixingDays, settleDate) {
.Call(`_RQuantLib_setCalendarContext`, calendar, fixingDays, settleDate)
}
isBusinessDay <- function(calendar, dates) {
.Call(`_RQuantLib_isBusinessDay`, calendar, dates)
}
isHoliday <- function(calendar, dates) {
.Call(`_RQuantLib_isHoliday`, calendar, dates)
}
isWeekend <- function(calendar, dates) {
.Call(`_RQuantLib_isWeekend`, calendar, dates)
}
isEndOfMonth <- function(calendar, dates) {
.Call(`_RQuantLib_isEndOfMonth`, calendar, dates)
}
getEndOfMonth <- function(calendar, dates) {
.Call(`_RQuantLib_getEndOfMonth`, calendar, dates)
}
adjust <- function(calendar, dates, bdc = 0L) {
.Call(`_RQuantLib_adjust`, calendar, dates, bdc)
}
advance1 <- function(calendar, amount, unit, bdcVal, emr, dates) {
.Call(`_RQuantLib_advance1`, calendar, amount, unit, bdcVal, emr, dates)
}
advance2 <- function(calendar, period, bdcVal, emr, dates) {
.Call(`_RQuantLib_advance2`, calendar, period, bdcVal, emr, dates)
}
businessDaysBetween <- function(calendar, from, to, includeFirst = TRUE, includeLast = FALSE) {
.Call(`_RQuantLib_businessDaysBetween`, calendar, from, to, includeFirst, includeLast)
}
getHolidayList <- function(calendar, from, to, includeWeekends = FALSE) {
.Call(`_RQuantLib_getHolidayList`, calendar, from, to, includeWeekends)
}
getBusinessDayList <- function(calendar, from, to) {
.Call(`_RQuantLib_getBusinessDayList`, calendar, from, to)
}
addHolidays <- function(calendar, dates) {
invisible(.Call(`_RQuantLib_addHolidays`, calendar, dates))
}
removeHolidays <- function(calendar, dates) {
invisible(.Call(`_RQuantLib_removeHolidays`, calendar, dates))
}
advanceDate <- function(issueDate, days) {
.Call(`_RQuantLib_advanceDate`, issueDate, days)
}
dayCount <- function(startDates, endDates, dayCounters) {
.Call(`_RQuantLib_dayCount`, startDates, endDates, dayCounters)
}
yearFraction <- function(startDates, endDates, dayCounters) {
.Call(`_RQuantLib_yearFraction`, startDates, endDates, dayCounters)
}
setEvaluationDate <- function(evalDate) {
.Call(`_RQuantLib_setEvaluationDate`, evalDate)
}
discountCurveEngine <- function(rparams, tslist, times, legParams) {
.Call(`_RQuantLib_discountCurveEngine`, rparams, tslist, times, legParams)
}
calibrateHullWhiteUsingCapsEngine <- function(termStrcDateVec, termStrcZeroVec, capDF, iborDateVec, iborZeroVec, iborType, evalDate) {
.Call(`_RQuantLib_calibrateHullWhiteUsingCapsEngine`, termStrcDateVec, termStrcZeroVec, capDF, iborDateVec, iborZeroVec, iborType, evalDate)
}
calibrateHullWhiteUsingSwapsEngine <- function(termStrcDateVec, termStrcZeroVec, swapDF, iborDateVec, iborZeroVec, iborType, evalDate) {
.Call(`_RQuantLib_calibrateHullWhiteUsingSwapsEngine`, termStrcDateVec, termStrcZeroVec, swapDF, iborDateVec, iborZeroVec, iborType, evalDate)
}
europeanOptionImpliedVolatilityEngine <- function(type, value, underlying, strike, dividendYield, riskFreeRate, maturity, volatility) {
.Call(`_RQuantLib_europeanOptionImpliedVolatilityEngine`, type, value, underlying, strike, dividendYield, riskFreeRate, maturity, volatility)
}
americanOptionImpliedVolatilityEngine <- function(type, value, underlying, strike, dividendYield, riskFreeRate, maturity, volguess, timesteps, gridpoints) {
.Call(`_RQuantLib_americanOptionImpliedVolatilityEngine`, type, value, underlying, strike, dividendYield, riskFreeRate, maturity, volguess, timesteps, gridpoints)
}
sabrengine <- function(rparam, legParams, dateVec, zeroVec, swaptionMat, swapLengths, atmVols, strikes, smirkVols) {
.Call(`_RQuantLib_sabrengine`, rparam, legParams, dateVec, zeroVec, swaptionMat, swapLengths, atmVols, strikes, smirkVols)
}
CreateSchedule <- function(params) {
.Call(`_RQuantLib_CreateSchedule`, params)
}
#' This function returns the QuantLib version string as encoded in the header
#' file \code{config.hpp} and determined at compilation time of the QuantLib library.
#'
#' @title Return the QuantLib version number
#' @return A character variable
#' @references \url{https://www.quantlib.org} for details on \code{QuantLib}.
#' @author Dirk Eddelbuettel
#' @examples
#' getQuantLibVersion()
getQuantLibVersion <- function() {
.Call(`_RQuantLib_getQuantLibVersion`)
}
#' This function returns a named vector of boolean variables describing several
#' configuration options determined at compilation time of the QuantLib library.
#'
#' Not all of these features are used (yet) by RQuantLib.
#' @title Return configuration options of the QuantLib library
#' @return A named vector of logical variables
#' @references \url{https://www.quantlib.org} for details on \code{QuantLib}.
#' @author Dirk Eddelbuettel
#' @examples
#' getQuantLibCapabilities()
getQuantLibCapabilities <- function() {
.Call(`_RQuantLib_getQuantLibCapabilities`)
}
europeanOptionEngine <- function(type, underlying, strike, dividendYield, riskFreeRate, maturity, volatility, discreteDividends, discreteDividendsTimeUntil) {
.Call(`_RQuantLib_europeanOptionEngine`, type, underlying, strike, dividendYield, riskFreeRate, maturity, volatility, discreteDividends, discreteDividendsTimeUntil)
}
americanOptionEngine <- function(type, underlying, strike, dividendYield, riskFreeRate, maturity, volatility, timeSteps, gridPoints, engine, discreteDividends, discreteDividendsTimeUntil) {
.Call(`_RQuantLib_americanOptionEngine`, type, underlying, strike, dividendYield, riskFreeRate, maturity, volatility, timeSteps, gridPoints, engine, discreteDividends, discreteDividendsTimeUntil)
}
europeanOptionArraysEngine <- function(type, par) {
.Call(`_RQuantLib_europeanOptionArraysEngine`, type, par)
}
zeroprice <- function(yield, maturity, settle, period, basis) {
.Call(`_RQuantLib_zeroprice`, yield, maturity, settle, period, basis)
}
zeroyield <- function(price, maturity, settle, period, basis) {
.Call(`_RQuantLib_zeroyield`, price, maturity, settle, period, basis)
}
# Register entry points for exported C++ functions
methods::setLoadAction(function(ns) {
.Call(`_RQuantLib_RcppExport_registerCCallable`)
})
RQuantLib/R/dayCounter.R 0000644 0001762 0000144 00000002500 12313406102 014541 0 ustar ligges users ## RQuantLib -- R interface to the QuantLib libraries
##
## Copyright (C) 2010 - 2011 Dirk Eddelbuettel and Khanh Nguyen
## Copyright (C) 2012 - 2014 Dirk Eddelbuettel
##
## This file is part of the RQuantLib library for GNU R.
## It is made available under the terms of the GNU General Public
## License, version 2, or at your option, any later version,
## incorporated herein by reference.
##
## This program 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 this program; if not, write to the Free
## Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
## MA 02111-1307, USA
#dayCount <- function(startDates, endDates, dayCounters) {
# val <- .Call('dayCount', startDates, endDates, dayCounters, PACKAGE="RQuantLib")
# invisible(val)
#}
#yearFraction <- function(startDates, endDates, dayCounters) {
# val <- .Call('yearFraction', startDates, endDates, dayCounters, PACKAGE="RQuantLib")
# invisible(val)
#}
#setEvaluationDate <- function(evalDate) {
# val <- .Call("setEvaluationDate", evalDate, PACKAGE="RQuantLib")
# invisible(val)
#}
RQuantLib/R/arrays.R 0000644 0001762 0000144 00000016514 14356061352 013754 0 ustar ligges users ## RQuantLib -- R interface to the QuantLib libraries
##
## Copyright (C) 2002 - 2014 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 .
oldEuropeanOptionArrays <- function(type, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility) {
n.underlying <- length(underlying)
n.strike <- length(strike)
n.dividendYield <- length(dividendYield)
n.riskFreeRate <- length(riskFreeRate)
n.maturity <- length(maturity)
n.volatility <- length(volatility)
res <- numeric(n.underlying * n.strike * n.dividendYield * n.riskFreeRate *
n.maturity * n.volatility)
dim(res) <- c(n.underlying, n.strike, n.dividendYield, n.riskFreeRate,
n.maturity, n.volatility)
dimnames(res) <- list(paste("s",underlying,sep="="),
paste("k",strike,sep="="),
paste("y",dividendYield,sep="="),
paste("r",riskFreeRate,sep="="),
paste("t",maturity,sep="="),
paste("v",volatility,sep="="))
value <- delta <- gamma <- vega <- theta <- rho <- divRho <- res
for (s in 1:n.underlying) {
for (k in 1:n.strike) {
for (y in 1:n.dividendYield) {
for (r in 1:n.riskFreeRate) {
for (t in 1:n.maturity) {
for (v in 1:n.volatility) {
val <- europeanOptionEngine(type, underlying, strike,
dividendYield, riskFreeRate,
maturity, volatility)
value[s,k,y,r,t,v] <- val$value
delta[s,k,y,r,t,v] <- val$delta
gamma[s,k,y,r,t,v] <- val$gamma
vega[s,k,y,r,t,v] <- val$vega
theta[s,k,y,r,t,v] <- val$theta
rho[s,k,y,r,t,v] <- val$rho
divRho[s,k,y,r,t,v] <- val$divRho
}
}
}
}
}
}
value <- drop(value)
delta <- drop(delta)
gamma <- drop(gamma)
vega <- drop(vega)
theta <- drop(theta)
rho <- drop(rho)
divRho <- drop(divRho)
invisible(list(value=value, delta=delta, gamma=gamma, vega=vega,
theta=theta, rho=rho, divRho=divRho,
parameters=list(type=type, underlying=underlying,
strike=strike, dividendYield=dividendYield,
riskFreeRate=riskFreeRate, maturity=maturity,
volatility=volatility)))
}
EuropeanOptionArrays <- function(type, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility) {
## check that we have two vectors
lv <- c(length(underlying) > 1,
length(strike) > 1,
length(dividendYield) > 1,
length(riskFreeRate) > 1, +
length(maturity) > 1, +
length(volatility) > 1)
if (sum(lv) != 2) {
warning("Need exactly two arguments as vectors")
return(NULL)
}
type <- match.arg(type, c("call", "put"))
## expand parameters
pars <- expand.grid(underlying, strike, dividendYield,
riskFreeRate, maturity, volatility)
nonconst <- which( apply(pars, 2, sd) != 0)
colnames <- c("spot", "strike", "div", "rfrate", "mat", "vol")
val <- europeanOptionArraysEngine(type, as.matrix(pars))
## turn list of vectors in to list of matrices
par1 <- unique(pars[, nonconst[1]])
par2 <- unique(pars[, nonconst[2]])
len1 <- length(par1)
len2 <- length(par2)
ml <- lapply(val, function(x) matrix(x, len1, len2, dimnames=list(par1,par2)))
return(c(ml, parameters=list(type=type, underlying=underlying,
strike=strike, dividendYield=dividendYield,
riskFreeRate=riskFreeRate, maturity=maturity,
volatility=volatility)))
}
plotOptionSurface <- function(EOres, ylabel="", xlabel="", zlabel="", fov=60) {
if (requireNamespace("rgl", quietly=TRUE)) {
if (missing(EOres)) {
message("No 'EOres' argument supplied. Calling 'EuropeanOptionArrays' to show 'delta'.\n",
"See help('EuropeanOptionArrays') for function parameters and available result\n",
"matrices in the returned list object.")
und.seq <- seq(10,180,by=2)
vol.seq <- seq(0.1,0.9,by=0.1)
## evaluate them along with three scalar parameters
EOarr <- EuropeanOptionArrays("call", underlying=und.seq,
strike=100, dividendYield=0.01,
riskFreeRate=0.03,
maturity=1, volatility=vol.seq)
EOres <- EOarr$delta
}
if (packageVersion("rgl") < "0.111.5")
surface3d <- rgl::rgl.surface
else
surface3d <- rgl::surface3d
axis.col <- "black"
text.col <- axis.col
ylab <- ylabel
xlab <- xlabel
zlab <- zlabel
y <- EOres
## clear scene:
rgl::clear3d()
rgl::clear3d(type="bbox")
rgl::clear3d(type="lights")
## setup env:
rgl::bg3d(color="#DDDDDD")
rgl::light3d()
rgl::view3d(fov=fov)
x <- 1:nrow(y)
z <- 1:ncol(y)
x <- (x-min(x))/(max(x)-min(x))
y <- (y-min(y))/(max(y)-min(y))
z <- (z-min(z))/(max(z)-min(z))
surface3d(x = x, y = y, z = z, alpha=0.6, lit=TRUE, color="blue")
rgl::lines3d(c(0,1), c(0,0), c(0,0), col=axis.col)
rgl::lines3d(c(0,0), c(0,1), c(0,0), col=axis.col)
rgl::lines3d(c(0,0),c(0,0), c(0,1), col=axis.col)
rgl::text3d(1,0,0, xlab, adj=1, col=text.col)
rgl::text3d(0,1,0, ylab, adj=1, col=text.col)
rgl::text3d(0,0,1, zlab, adj=1, col=text.col)
## add grid (credit's to John Fox scatter3d)
xgridind <- round(seq(1, nrow(y), length=25))
zgridind <- round(seq(1, ncol(y), length=25))
surface3d(x = x[xgridind], y = y[xgridind,zgridind], z = z[zgridind],
color="darkgray", alpha=0.5, lit=TRUE,
front="lines", back="lines")
## animate (credit to view3d() example)
start <- proc.time()[3]
while ((i <- 36*(proc.time()[3]-start)) < 360) {
rgl::view3d(i,i/8);
}
} else {
message("Please install the 'rgl' package before using this function.")
}
}
utils::globalVariables(c("clear3d", "bg3d", "ligh3d", "view3d", "surface3d", "text3d"))
RQuantLib/R/affine.R 0000644 0001762 0000144 00000015631 14234647545 013713 0 ustar ligges users ## RQuantLib function AffineSwaption
##
## Copyright (C) 2005 Dominick Samperi
## Copyright (C) 2007 - 2014 Dirk Eddelbuettel
## Copyright (C) 2016 - 2022 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 .
AffineSwaption <- function(params,
ts, swaptionMaturities,
swapTenors, volMatrix,
legparams=list(dayCounter="Thirty360",
fixFreq="Annual",
floatFreq="Semiannual")) {
UseMethod("AffineSwaption")
}
AffineSwaption.default <- function(params,
ts, swaptionMaturities,
swapTenors, volMatrix,
legparams=list(dayCounter="Thirty360",
fixFreq="Annual",
floatFreq="Semiannual")) {
# Check that params list names
if (!is.list(params) || length(params) == 0) {
stop("The params parameter must be a non-empty list", call.=FALSE)
}
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$maturity)){
params$maturity=advance("UnitedStates",params$startDate, 5, 3)
warning("swaption maturity not set, defaulting to 5 years from startDate using US calendar")
}
if(is.null(params$european)){
params$european=TRUE
warning("affine swaption european flag not set defaulting to european")
}
if(is.null(params$payFix)){
params$payFix=TRUE
warning("affine swaption payFix flag not set defaulting to pay fix swap")
}
matYears=as.numeric(params$maturity-params$tradeDate)/365
expYears=as.numeric(params$startDate-params$tradeDate)/365
increment=min(matYears/6,1.0)
numObs=floor(matYears/increment)+1
optStart=as.numeric(params$startDate-params$tradeDate)/365
# find closest option to our target to ensure it is in calibration
tenor=expiry=vol=vector(length=numObs,mode="numeric")
expiryIDX=findInterval(expYears,swaptionMaturities)
tenorIDX=findInterval(matYears-expYears,swapTenors)
if(tenorIDX >0 & expiryIDX>0){
vol[1]=volMatrix[expiryIDX,tenorIDX]
expiry[1]=swaptionMaturities[expiryIDX]
tenor[1]=swapTenors[tenorIDX]
} else {
vol[1]=expiry[1]=tenor[1]=0
}
for(i in 2:numObs){
expiryIDX=findInterval(i*increment,swaptionMaturities)
tenorIDX=findInterval(matYears-(i-1)*increment,swapTenors)
if(tenorIDX >0 & expiryIDX>0){
vol[i]=volMatrix[expiryIDX,tenorIDX]
expiry[i]=swaptionMaturities[expiryIDX]
tenor[i]=swapTenors[tenorIDX]
} else {
vol[i]=volMatrix[expiryIDX,tenorIDX+1]
expiry[i]=swaptionMaturities[expiryIDX]
tenor[i]=swapTenors[tenorIDX+1]
}
}
# remove if search was out of bounds
expiry=expiry[expiry>0];tenor=tenor[tenor>0];vol=vol[vol>0]
if(length(expiry)<5){
warning("Insufficent vols to fit affine model")
return(NULL)
}
#Take 1st 5 which includes closest to initial date
expiry=expiry[1:5];tenor=tenor[1:5];vol=vol[1:5]
# Finally ready to make the call...
# We could coerce types here and pass as.integer(round(swapTenors)),
# temp <- as.double(volMatrix), dim(temp) < dim(a) [and pass temp instead
# of volMatrix]. But this is taken care of in the C/C++ code.
if (inherits(ts, "DiscountCurve")) {
matchlegs<-matchParams(legparams)
val <- affineWithRebuiltCurveEngine(params, matchlegs, c(ts$table$date), ts$table$zeroRates,
expiry,tenor,vol)
} else{
stop("DiscountCurve class term structure required", call.=FALSE)
}
class(val) <- paste(params$method, "AffineSwaption",sep="")
summary(val)
val
}
summary.G2AnalyticAffineSwaption <- function(object,...) {
cat('\n\tSummary of pricing results for Affine Swaption\n')
cat('\nPrice (in bp) of Affine swaption is ', object$NPV)
cat('\nStike is ', format(object$strike,digits=6))
cat(' (ATM strike is ', format(object$ATMStrike,digits=6), ')')
cat('\nModel used is: G2/Jamshidian using analytic formulas')
cat('\nCalibrated model parameters are:')
cat('\na = ', format(object$a,digits=4))
cat('\nb = ', format(object$b,digits=4))
cat('\nsigma = ', format(object$sigma,digits=4))
cat('\neta = ', format(object$eta,digits=4))
cat('\nrho = ', format(object$rho,digits=4))
cat('\n\n')
}
summary.HWAnalyticAffineSwaption <- function(object,...) {
cat('\n\tSummary of pricing results for Affine Swaption\n')
cat('\nPrice (in bp) of Affine swaption is ', object$NPV)
cat('\nStike is ', format(object$params$strike,digits=6))
cat(' (ATM strike is ', format(object$ATMStrike,digits=6), ')')
cat('\nModel used is: Hull-White using analytic formulas')
cat('\nCalibrated model parameters are:')
cat('\na = ', format(object$a,digits=4))
cat('\nsigma = ', format(object$sigma,digits=4))
cat('\n\n')
}
summary.HWTreeAffineSwaption <- function(object,...) {
cat('\n\tSummary of pricing results for Affine Swaption\n')
cat('\nPrice (in bp) of Affine swaption is ', object$NPV)
cat('\nStike is ', format(object$params$strike,digits=6))
cat(' (ATM strike is ', format(object$ATMStrike,digits=6), ')')
cat('\nModel used is: Hull-White using a tree')
cat('\nCalibrated model parameters are:')
cat('\na = ', format(object$a,digits=4))
cat('\nsigma = ', format(object$sigma,digits=4))
cat('\n\n')
}
summary.BKTreeAffineSwaption <- function(object,...) {
cat('\n\tSummary of pricing results for Affine Swaption\n')
cat('\nPrice (in bp) of Affine swaption is ', object$NPV)
cat('\nStike is ', format(object$params$strike,digits=6))
cat(' (ATM strike is ', format(object$ATMStrike,digits=6), ')')
cat('\nModel used is: Black-Karasinski using a tree')
cat('\nCalibrated model parameters are:')
cat('\na = ', format(object$a,digits=4))
cat('\nsigma = ', format(object$sigma,digits=4))
cat('\n\n')
}
RQuantLib/R/option.R 0000644 0001762 0000144 00000011641 13005133672 013752 0 ustar ligges users ## RQuantLib -- R interface to the QuantLib libraries
##
## Copyright (C) 2002 - 2016 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 .
EuropeanOption <- function(type, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility,
discreteDividends = NULL, discreteDividendsTimeUntil = NULL) {
UseMethod("EuropeanOption")
}
EuropeanOption.default <- function(type, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility,
discreteDividends = NULL, discreteDividendsTimeUntil = NULL) {
type <- match.arg(type, c("call", "put"))
val <- europeanOptionEngine(type, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility,
discreteDividends, discreteDividendsTimeUntil)
class(val) <- c("EuropeanOption", "Option")
val
}
AmericanOption <- function(type, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility,
timeSteps=150, gridPoints=149,
engine="BaroneAdesiWhaley",
discreteDividends = NULL, discreteDividendsTimeUntil = NULL) {
UseMethod("AmericanOption")
}
AmericanOption.default <- function(type, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility,
timeSteps=150, gridPoints=149,
engine="BaroneAdesiWhaley",
discreteDividends = NULL, discreteDividendsTimeUntil = NULL) {
type <- match.arg(type, c("call", "put"))
engine <- match.arg(engine, c("BaroneAdesiWhaley", "CrankNicolson"))
val <- americanOptionEngine(type, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility,
timeSteps, gridPoints, engine,
discreteDividends, discreteDividendsTimeUntil)
class(val) <- c("AmericanOption","Option")
val
}
BinaryOption <- function(binType, type, excType, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility,
cashPayoff) {
UseMethod("BinaryOption")
}
BinaryOption.default <- function(binType, type, excType, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility,
cashPayoff) {
type <- match.arg(type, c("call", "put"))
binType <- match.arg(binType, c("cash", "asset", "gap"))
excType <- match.arg(excType, c("american", "european"))
val <- binaryOptionEngine(binType, type, excType, underlying,
strike, dividendYield, riskFreeRate,
maturity, volatility, cashPayoff)
class(val) <- c("BinaryOption", "Option")
val
}
BarrierOption <- function(barrType, type, underlying, strike,
dividendYield, riskFreeRate, maturity,
volatility, barrier, rebate=0.0) {
UseMethod("BarrierOption")
}
BarrierOption.default <- function(barrType, type, underlying, strike,
dividendYield, riskFreeRate, maturity,
volatility, barrier, rebate=0.0) {
type <- match.arg(type, c("call", "put"))
barrType <- match.arg(barrType, c("downin", "upin", "downout", "upout"))
val <- barrierOptionEngine(barrType, type, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility, barrier, rebate)
class(val) <- c("BarrierOption", "Option")
val
}
plot.Option <- function(x, ...) {
warning("No plotting available for class", class(x)[1],"\n")
invisible(x)
}
print.Option <- function(x, digits=4, ...) {
cat("Concise summary of valuation for", class(x)[1], "\n")
print(round(unlist(x[1:7]), digits))
invisible(x)
}
summary.Option <- function(object, digits=4, ...) {
cat("Detailed summary of valuation for", class(object)[1], "\n")
print(round(unlist(object[1:7]), digits))
cat("with parameters\n")
print(unlist(object[["parameters"]]))
invisible(object)
}
RQuantLib/R/hullWhiteCalibration.R 0000644 0001762 0000144 00000004021 12315613340 016547 0 ustar ligges users ## RQuantLib -- R interface to the QuantLib libraries
##
## Copyright (C) 2010 Dirk Eddelbuettel and Khanh Nguyen
##
## 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 .
hullWhiteCalibrateUsingCap <- function(termStrc, capHelpers,
index, evaluationDate) {
capData <- capHelpers$data
ibor <- index$term
val <- calibrateHullWhiteUsingCapsEngine(termStrc$table$date,
termStrc$table$zeroRates,
capData,
ibor$table$date,
ibor$table$zeroRates,
index$type,
evaluationDate)
}
hullWhiteCalibrateUsingSwap <- function(termStrc, swapHelpers,
index, evaluationDate) {
swapData <- swapHelpers$data
ibor <- index$term
val <- calibrateHullWhiteUsingSwapsEngine(termStrc$table$date,
termStrc$table$zeroRates,
swapData,
ibor$table$date,
ibor$table$zeroRates,
index$type,
evaluationDate)
}
RQuantLib/R/implied.R 0000644 0001762 0000144 00000007573 12315617667 014114 0 ustar ligges users ## RQuantLib -- R interface to the QuantLib libraries
##
## Copyright (C) 2002 - 2014 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 .
## also dumps core (0.3.7)
## no longer under 0.3.9 and 0.3.10 with g++ 3.4/4.0
EuropeanOptionImpliedVolatility <- function(type, value, underlying,
strike, dividendYield,
riskFreeRate, maturity,
volatility) {
UseMethod("EuropeanOptionImpliedVolatility")
}
EuropeanOptionImpliedVolatility.default <- function(type, value, underlying,
strike, dividendYield,
riskFreeRate, maturity,
volatility) {
val <- europeanOptionImpliedVolatilityEngine(type, value, underlying, strike,
dividendYield, riskFreeRate,
maturity, volatility)
class(val) <- c("EuropeanOptionImpliedVolatility","ImpliedVolatility")
val
}
# also dumps core (0.3.7)
## no longer under 0.3.9 and 0.3.10 with g++ 3.4/4.0
AmericanOptionImpliedVolatility <- function(type, value, underlying, strike,
dividendYield, riskFreeRate,
maturity, volatility,
timeSteps=150, gridPoints=151) {
UseMethod("AmericanOptionImpliedVolatility")
}
AmericanOptionImpliedVolatility.default <- function(type, value, underlying, strike,
dividendYield, riskFreeRate, maturity,
volatility, timeSteps=150, gridPoints=151) {
val <- americanOptionImpliedVolatilityEngine(type, value, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility, timeSteps, gridPoints)
class(val) <- c("AmericanOptionImpliedVolatility","ImpliedVolatility")
val
}
BinaryOptionImpliedVolatility <- function(type, value, underlying, strike, dividendYield, riskFreeRate,
maturity, volatility, cashPayoff=1) {
UseMethod("BinaryOptionImpliedVolatility")
}
BinaryOptionImpliedVolatility.default <- function(type, value, underlying, strike, dividendYield, riskFreeRate,
maturity, volatility, cashPayoff=1) {
val <- binaryOptionImpliedVolatilityEngine(type, value, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility, cashPayoff)
class(val) <- c("BinaryOptionImpliedVolatility","ImpliedVolatility")
val
}
print.ImpliedVolatility <- function(x, digits=3, ...) {
impvol <- x[[1]]
cat("Implied Volatility for", class(x)[1], "is", round(impvol, digits), "\n")
invisible(x)
}
summary.ImpliedVolatility <- function(object, digits=3, ...) {
impvol <- object[[1]]
cat("Implied Volatility for", class(object)[1], "is", round(impvol, digits), "\n")
cat("with parameters\n")
print(unlist(object[[2]]))
invisible(object)
}
RQuantLib/R/zzz.R 0000644 0001762 0000144 00000003634 14611016101 013271 0 ustar ligges users ## RQuantLib -- R interface to the QuantLib libraries
##
## Copyright (C) 2002 - 2024 Dirk Eddelbuettel
##
## This file is part of the RQuantLib library for GNU R.
## It is made available under the terms of the GNU General Public
## License, version 2, or at your option, any later version,
## incorporated herein by reference.
##
## This program 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 this program; if not, write to the Free
## Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
## MA 02111-1307, USA
#.First.lib <- function(lib, pkg) {
# #cat("This is a pre-release. The interface might change...\n")
# library.dynam("RQuantLib", pkg, lib )
#}
.onAttach <- function(libname, pkgname) {
## if it is not interactive (as eg in testing or cronjobs), do nothing
if (!interactive()) return(invisible(NULL))
## else let's test the QuantLib version, and then the intraday capability
qlver <- gsub("-[a-z]+", "", getQuantLibVersion())
if (compareVersion(qlver, "1.7") < 0) {
packageStartupMessage("QuantLib version ", qlver, " detected which is older than 1.7.")
packageStartupMessage("Intra-daily options analytics unavailable with that version.")
} else if (!getQuantLibCapabilities()[["intradayDate"]]) {
packageStartupMessage("Sufficient QuantLib version with insufficient configuration.")
packageStartupMessage("Try configuring your build with the --enable-intraday argument.")
}
packageStartupMessage("RQuantLib ", packageVersion("RQuantLib"), " built with QuantLib version ",
qlver, ". See https://www.quantlib.org for more on QuantLib.")
}
RQuantLib/R/bond.R 0000644 0001762 0000144 00000074473 12722576357 013420 0 ustar ligges users ## RQuantLib -- R interface to the QuantLib libraries
##
## Copyright (C) 2002 - 2014 Dirk Eddelbuettel
## Copyright (C) 2009 Khanh Nguyen
## Copyright (C) 2010 - 2011 Dirk Eddelbuettel and Khanh Nguyen
##
## 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 .
ZeroCouponBond <- function(bond, discountCurve, dateparams ) {
UseMethod("ZeroCouponBond")
}
## TODO: redo interface here
ZeroCouponBond.default <- function(bond,
discountCurve,
dateparams=list(refDate=bond$issueDate,
settlementDays=1,
calendar='UnitedStates/GovernmentBond',
businessDayConvention='Following')) {
val <- 0
if (is.null(bond$faceAmount)) bond$faceAmount <- 100
if (is.null(bond$redemption)) bond$redemption <- 100
if (is.null(dateparams$settlementDays)) dateparams$settlementDays <- 1
if (is.null(dateparams$calendar)) dateparams$calendar <- 'UnitedStates/GovernmentBond'
if (is.null(dateparams$businessDayConvention)) dateparams$businessDayConvention <- 'Following'
if (is.null(dateparams$refDate)) dateparams$refDate <- bond$issueDate
dateparams <- matchParams(dateparams)
val <- ZeroBondWithRebuiltCurve(bond, c(discountCurve$table$date),
discountCurve$table$zeroRates, dateparams)
class(val) <- c("ZeroCouponBond", "Bond")
val
}
ZeroPriceByYield <- function(yield, faceAmount,
issueDate, maturityDate,
dayCounter, frequency,
compound, businessDayConvention){
UseMethod("ZeroPriceByYield")
}
ZeroPriceByYield.default <- function(yield, faceAmount=100,
issueDate, maturityDate,
dayCounter=2, frequency=2,
compound=0, businessDayConvention=4) {
val <- zeroPriceByYieldEngine(yield, faceAmount, dayCounter,
frequency, businessDayConvention,
compound, maturityDate, issueDate)
class(val) <- c("ZeroPriceByYield")
val
}
ZeroYield <- function(price, faceAmount, issueDate, maturityDate,
dayCounter, frequency, compound, businessDayConvention) {
UseMethod("ZeroYield")
}
ZeroYield.default <- function(price, faceAmount=100,
issueDate, maturityDate,
dayCounter=2, frequency=2,
compound=0, businessDayConvention=4) {
val <- zeroYieldByPriceEngine(price, faceAmount, dayCounter, frequency,
businessDayConvention, compound,
maturityDate, issueDate)
class(val) <- c("ZeroYield")
val
}
FixedRateBond <- function(bond, rates, schedule, calc, discountCurve, yield, price){
UseMethod("FixedRateBond")
}
FixedRateBond.default <- function(bond = list(),
rates,
schedule,
calc=list(
dayCounter='ActualActual.ISMA',
compounding='Compounded',
freq='Annual',
durationType='Modified'),
discountCurve = NULL,
yield = NA,
price = NA){
val <- 0
# check bond params
if (is.null(bond$settlementDays)) bond$settlementDays <- 1
if (is.null(bond$faceAmount)) bond$faceAmount <- 100
if (is.null(bond$dayCounter)) bond$dayCounter <- 'Thirty360'
# additional parameters have default values on cpp side (see QuantLib::FixedRateBond first ctor)
# paymentConvention
# redemption
# issueDate
# paymentCalendar
# exCouponPeriod
# exCouponCalendar
# exCouponConvention
# exCouponEndOfMonth
bond <- matchParams(bond)
# check schedule params
if (is.null(schedule$effectiveDate)){
stop("schedule effective date undefined.")
}
if (is.null(schedule$maturityDate)){
stop("schedule maturity date undefined.")
}
if (is.null(schedule$period)) schedule$period <- 'Semiannual'
if (is.null(schedule$calendar)) schedule$calendar <- 'TARGET'
if (is.null(schedule$businessDayConvention)) schedule$businessDayConvention <- 'Following'
if (is.null(schedule$terminationDateConvention)) schedule$terminationDateConvention <- 'Following'
if (is.null(schedule$dateGeneration)) schedule$dateGeneration <- 'Backward'
if (is.null(schedule$endOfMonth)) schedule$endOfMonth <- 0
schedule <- matchParams(schedule)
# check calc params
if (is.null(calc$dayCounter)) calc$dayCounter <- 'ActualActual.ISMA'
if (is.null(calc$compounding)) calc$compounding <- 'Compounded'
if (is.null(calc$freq)) calc$freq <- 'Annual'
if (is.null(calc$durationType)) calc$durationType <- 'Simple'
if (is.null(calc$accuracy)) calc$accuracy <- 1.0e-8
if (is.null(calc$maxEvaluations)) calc$maxEvaluations <- 100
calc <- matchParams(calc)
which.calc <- !c(is.null(discountCurve), is.na(yield), is.na(price))
if (sum(which.calc) != 1)
stop("one and only one of discountCurve, yield or price must be defined.")
if (!is.null(discountCurve)) {
val <- FixedRateWithRebuiltCurve(
bond, rates, schedule, calc, c(discountCurve$table$date), discountCurve$table$zeroRates)
} else if (!is.na(yield)) {
val <- FixedRateWithYield(bond, rates, schedule, calc, yield)
} else if (!is.na(price)) {
val <- FixedRateWithPrice(bond, rates, schedule, calc, price)
}
class(val) <- c("FixedRateBond", "Bond")
val
}
FixedRateBondYield <- function(settlementDays, price, faceAmount,
effectiveDate, maturityDate,
period, calendar, rates,
dayCounter, businessDayConvention,
compound, redemption, issueDate) {
UseMethod("FixedRateBondYield")
}
FixedRateBondYield.default <- function(settlementDays = 1, price, faceAmount=100,
effectiveDate, maturityDate,
period, calendar = "UnitedStates/GovernmentBond", rates,
dayCounter=2, businessDayConvention=0,
compound = 0, redemption = 100, issueDate) {
val <- fixedRateBondYieldByPriceEngine(settlementDays, price, calendar, faceAmount,
businessDayConvention,
compound, redemption, dayCounter,
period, ## aka frequency
maturityDate, issueDate, effectiveDate,
rates)
class(val) <- c("FixedRateBondYield")
val
}
FixedRateBondPriceByYield <- function(settlementDays, yield, faceAmount,
effectiveDate, maturityDate,
period, calendar, rates,
dayCounter, businessDayConvention,
compound, redemption, issueDate) {
UseMethod("FixedRateBondPriceByYield")
}
FixedRateBondPriceByYield.default <- function(settlementDays = 1, yield, faceAmount=100,
effectiveDate=issueDate, maturityDate,
period, calendar = "UnitedStates/GovernmentBond", rates,
dayCounter=2, businessDayConvention=0,
compound = 0, redemption = 100, issueDate) {
val <- fixedRateBondPriceByYieldEngine(settlementDays, yield, calendar, faceAmount,
businessDayConvention,
compound, redemption, dayCounter, period,
maturityDate, issueDate, effectiveDate,
rates)
class(val) <- c("FixedRateBondPriceByYield")
val
}
FloatingRateBond <- function(bond, gearings, spreads, caps, floors,
index, curve, dateparams){
UseMethod("FloatingRateBond")
}
FloatingRateBond.default <- function(bond,
gearings=vector(),
spreads=vector(),
caps=vector(),
floors=vector(),
index,
curve,
dateparams=list(refDate=bond$issueDate-2,
settlementDays=1,
calendar='UnitedStates/GovernmentBond',
businessDayConvention='Following',
terminationDateConvention='Following',
dayCounter='Thirty360',
period='Semiannual',
dateGeneration='Backward',
endOfMonth=0,
fixingDays=2)
) {
val <- 0
if (is.null(bond$faceAmount)) bond$faceAmount <- 100
if (is.null(bond$redemption)) bond$redemption <- 100
if (is.null(bond$effectiveDate)) bond$effectiveDate <- bond$issueDate
if (is.null(dateparams$settlementDays)) dateparams$settlementDays <- 1
if (is.null(dateparams$calendar)) dateparams$calendar <- 'UnitedStates/GovernmentBond'
if (is.null(dateparams$businessDayConvention)) dateparams$businessDayConvention <- 'Following'
if (is.null(dateparams$terminationDateConvention)) dateparams$terminationDateConvention <- 'Following'
if (is.null(dateparams$dayCounter)) dateparams$dayCounter <- 'Thirty360'
if (is.null(dateparams$period)) dateparams$period <- 'Semiannual'
if (is.null(dateparams$dateGeneration)) dateparams$dateGeneration <- 'Backward'
if (is.null(dateparams$endOfMonth)) dateparams$endOfMonth <- 0
if (is.null(dateparams$fixingDays)) dateparams$fixingDays <- 2
if (is.null(dateparams$refDate)) dateparams$refDate <- bond$issueDate-2
dateparams <- matchParams(dateparams)
indexparams <- list(type=index$type, length=index$length, inTermOf=index$inTermOf)
ibor <- index$term
val <- floatingWithRebuiltCurveEngine(bond, gearings, spreads, caps, floors, indexparams,
c(ibor$table$date), ibor$table$zeroRates,
c(curve$table$date), curve$table$zeroRates,
dateparams)
class(val) <- c("FloatingRateBond", "Bond")
val
}
ConvertibleZeroCouponBond <- function(bondparams, process, dateparams){
UseMethod("ConvertibleZeroCouponBond")
}
ConvertibleZeroCouponBond.default <- function(bondparams,
process,
dateparams=list(
settlementDays=1,
calendar='UnitedStates/GovernmentBond',
dayCounter='Thirty360',
period='Semiannual',
businessDayConvention='Following'
)
) {
val <- 0
if (is.null(bondparams$exercise)) bondparams$exercise <- 'am'
if (is.null(bondparams$faceAmount)) bondparams$faceAmount <- 100
if (is.null(bondparams$redemption)) bondparams$redemption <- 100
if (is.null(bondparams$divSch)) {
bondparams$divSch <- data.frame(Type=character(0), Amount=numeric(0),
Rate <- numeric(0), Date = as.Date(character(0)))
}
if (is.null(bondparams$callSch)){
bondparams$callSch <- data.frame(Price=numeric(0), Type=character(0),
Date <- as.Date(character(0)))
}
if (is.null(dateparams$settlementDays)) dateparams$settlementDays <- 1
if (is.null(dateparams$calendar)) dateparams$calendar <- 'UnitedStates/GovernmentBond'
if (is.null(dateparams$businessDayConvention)) dateparams$businessDayConvention <- 'Following'
if (is.null(dateparams$dayCounter)) dateparams$dayCounter <- 'Thirty360'
if (is.null(dateparams$period)) dateparams$period <- 'Semiannual'
dateparams <- matchParams(dateparams)
callabilitySchedule <- bondparams$callSch
dividendSchedule <- bondparams$divSch
dividendYield <- process$divYield
riskFreeRate <- process$rff
val <- convertibleZeroBondEngine(bondparams, process,
c(dividendYield$table$date),
dividendYield$table$zeroRates,
c(riskFreeRate$table$date),
riskFreeRate$table$zeroRates,
dividendSchedule, callabilitySchedule, dateparams)
class(val) <- c("ConvertibleZeroCouponBond", "Bond")
val
}
ConvertibleFixedCouponBond <- function(bondparams, coupon, process, dateparams){
UseMethod("ConvertibleFixedCouponBond")
}
ConvertibleFixedCouponBond.default <- function(bondparams,
coupon,
process,
dateparams=list(
settlementDays=1,
calendar='UnitedStates/GovernmentBond',
dayCounter='Thirty360',
period='Semiannual',
businessDayConvention='Following'
)
){
val <- 0
if (is.null(bondparams$exercise)) bondparams$exercise <- 'am'
if (is.null(bondparams$faceAmount)) bondparams$faceAmount <- 100
if (is.null(bondparams$redemption)) bondparams$redemption <- 100
if (is.null(bondparams$divSch)) {
bondparams$divSch <- data.frame(Type=character(0), Amount=numeric(0),
Rate = numeric(0), Date = as.Date(character(0)))
}
if (is.null(bondparams$callSch)) {
bondparams$callSch <- data.frame(Price=numeric(0), Type=character(0),
Date=as.Date(character(0)))
}
if (is.null(dateparams$settlementDays)) dateparams$settlementDays <- 1
if (is.null(dateparams$calendar)) dateparams$calendar <- 'UnitedStates/GovernmentBond'
if (is.null(dateparams$businessDayConvention)) dateparams$businessDayConvention <- 'Following'
if (is.null(dateparams$dayCounter)) dateparams$dayCounter <- 'Thirty360'
if (is.null(dateparams$period)) dateparams$period <- 'Semiannual'
dateparams <- matchParams(dateparams)
callabilitySchedule <- bondparams$callSch
dividendSchedule <- bondparams$divSch
dividendYield <- process$divYield
riskFreeRate <- process$rff
val <- convertibleFixedBondEngine(bondparams, coupon, process,
c(dividendYield$table$date),
dividendYield$table$zeroRates,
c(riskFreeRate$table$date),
riskFreeRate$table$zeroRates,
dividendSchedule, callabilitySchedule, dateparams)
class(val) <- c("ConvertibleFixedCouponBond", "Bond")
val
}
ConvertibleFloatingCouponBond <- function(bondparams, iborindex,spread, process, dateparams){
UseMethod("ConvertibleFloatingCouponBond")
}
ConvertibleFloatingCouponBond.default <- function(bondparams,
iborindex,
spread,
process,
dateparams=list(
settlementDays=1,
calendar='UnitedStates/GovernmentBond',
dayCounter='Thirty360',
period='Semiannual',
businessDayConvention='Following'
)){
val <- 0
if (is.null(bondparams$exercise)) bondparams$exercise <- 'am'
if (is.null(bondparams$faceAmount)) bondparams$faceAmount <- 100
if (is.null(bondparams$redemption)) bondparams$redemption <- 100
if (is.null(bondparams$divSch)) {
bondparams$divSch <- data.frame(Type=character(0), Amount=numeric(0),
Rate = numeric(0), Date = as.Date(character(0)))
}
if (is.null(bondparams$callSch)) {
bondparams$callSch <- data.frame(Price=numeric(0), Type=character(0),
Date=as.Date(character(0)))
}
if (is.null(dateparams$settlementDays)) dateparams$settlementDays <- 1
if (is.null(dateparams$calendar)) dateparams$calendar <- 'UnitedStates/GovernmentBond'
if (is.null(dateparams$businessDayConvention)) dateparams$businessDayConvention <- 'Following'
if (is.null(dateparams$dayCounter)) dateparams$dayCounter <- 'Thirty360'
if (is.null(dateparams$period)) dateparams$period <- 'Semiannual'
dateparams <- matchParams(dateparams)
callabilitySchedule <- bondparams$callSch
dividendSchedule <- bondparams$divSch
dividendYield <- process$divYield
riskFreeRate <- process$rff
indexparams <- list(type=iborindex$type, length=iborindex$length,
inTermOf=iborindex$inTermOf)
ibor <- iborindex$term
val <- convertibleFloatingBondEngine(bondparams, process,
c(dividendYield$table$date),
dividendYield$table$zeroRates,
c(riskFreeRate$table$date),
riskFreeRate$table$zeroRates,
c(ibor$table$date),
ibor$table$zeroRates,
indexparams,spread,
dividendSchedule, callabilitySchedule,
dateparams)
class(val) <- c("ConvertibleFloatingCouponBond", "Bond")
val
}
CallableBond <- function(bondparams, hullWhite, coupon, dateparams){
UseMethod("CallableBond")
}
CallableBond.default <- function(bondparams, hullWhite,
coupon,
dateparams=list(
settlementDays=1,
calendar='UnitedStates/GovernmentBond',
dayCounter='Thirty360',
period='Semiannual',
businessDayConvention='Following',
terminationDateConvention='Following'
)){
val <- 0
if (is.null(bondparams$faceAmount)) bondparams$faceAmount <- 100
if (is.null(bondparams$redemption)) bondparams$redemption <- 100
if (is.null(bondparams$callSch)) {
bondparams$callSch <- data.frame(Price=numeric(0), Type=character(0),
Date=as.Date(character(0)))
}
if (is.null(dateparams$settlementDays)) dateparams$settlementDays <- 1
if (is.null(dateparams$calendar)) dateparams$calendar <- 'UnitedStates/GovernmentBond'
if (is.null(dateparams$businessDayConvention)) dateparams$businessDayConvention <- 'Following'
if (is.null(dateparams$terminationDateConvention)) dateparams$terminationDateConvention <- 'Following'
if (is.null(dateparams$dayCounter)) dateparams$dayCounter <- 'Thirty360'
if (is.null(dateparams$period)) dateparams$period <- 'Semiannual'
dateparams <- matchParams(dateparams)
callSch <- bondparams$callSch
# hw.termStructure <- hullWhite$term
val <- callableBondEngine(bondparams, hullWhite,coupon,
## c(hw.termStructure$table$date),
## hw.termStructure$table$zeroRates,
callSch, dateparams)
class(val) <- c("CallableBond", "Bond")
val
}
FittedBondCurve <- function(curveparams,
lengths,
coupons,
marketQuotes,
dateparams){
UseMethod("FittedBondCurve")
}
FittedBondCurve.default <- function(curveparams,
lengths,
coupons,
marketQuotes,
dateparams){
val <- 0
dateparams <- matchParams(dateparams)
val <- fittedBondCurveEngine(curveparams, lengths, coupons, marketQuotes, dateparams)
class(val) <- c("DiscountCurve")
val
}
#CMSBond <- function(bondparams, swapIndex, cap, floor, gearings, spreads
# pricer, iborIndex){
# UseMethod("CMSBond")
#}
#CMSBond.default <- function(bondparams, iborIndex, swapIndex, cap, floor, gearings,
# spreads, pricer){
# val <- 0
# swaptionVol <- pricer$swaptionVol
# atmOptionTenors <- swaptionVol$atmOptionTenors
# atmSwapTenors <- swaptionVol$atmSwapTenors
# volMatrix <- swaptionVol$volatilityMatrix
# swapIndex <- matchParams(swapIndex)
# ibor <- iborIndex$term
# val <- .Call("CMSBond", bondparams, iborIndex, swapIndex, cap, floor, gearings, spreads,
# swaptionVol, atmOptionTenors, atmSwapTenors, volMatrix, pricer
# ibor$table$dates, ibor$table$zeroRates)
#}
# matching functions
matchDayCounter <- function(daycounter = c("Actual360", "ActualFixed", "ActualActual",
"Business252", "OneDayCounter", "SimpleDayCounter", "Thirty360", "Actual365NoLeap",
"ActualActual.ISMA", "ActualActual.Bond", "ActualActual.ISDA", "ActualActual.Historical", "ActualActual.AFB", "ActualActual.Euro"))
{
if (!is.numeric(daycounter)) {
daycounter <- match.arg(daycounter)
daycounter <- switch(daycounter,
Actual360 = 0,
ActualFixed = 1,
ActualActual = 2,
Business252 = 3,
OneDayCounter = 4,
SimpleDayCounter = 5,
Thirty360 = 6,
Actual365NoLeap = 7,
ActualActual.ISMA = 8,
ActualActual.Bond = 9,
ActualActual.ISDA = 10,
ActualActual.Historical = 11,
ActualActual.AFB = 12,
ActualActual.Euro = 13)
}
daycounter
}
matchBDC <- function(bdc = c("Following", "ModifiedFollowing",
"Preceding", "ModifiedPreceding",
"Unadjusted", "HalfMonthModifiedFollowing", "Nearest")) {
if (!is.numeric(bdc)){
bdc <- match.arg(bdc)
bdc <- switch(bdc,
Following = 0,
ModifiedFollowing = 1,
Preceding = 2,
ModifiedPreceding = 3,
Unadjusted = 4,
HalfMonthModifiedFollowing = 5,
Nearest = 6)
}
bdc
}
matchCompounding <- function(cp = c("Simple", "Compounded",
"Continuous", "SimpleThenCompounded")) {
if (!is.numeric(cp)){
cp <- match.arg(cp)
cp <- switch(cp,
Simple = 0,
Compounded = 1,
Continuous = 2,
SimpleThenCompounded = 3)
}
cp
}
matchFrequency <- function(freq = c("NoFrequency","Once", "Annual",
"Semiannual", "EveryFourthMonth",
"Quarterly", "Bimonthly", "Monthly",
"EveryFourthWeek", "Biweekly",
"Weekly", "Daily")) {
if (!is.numeric(freq)){
freq <- match.arg(freq)
freq <- switch(freq,
NoFrequency = -1, Once = 0, Annual = 1,
Semiannual = 2, EveryFourthMonth = 3,
Quarterly = 4, Bimonthly = 6,
Monthly = 12, EveryFourthWeek = 13,
Biweekly = 26, Weekly = 52, Daily = 365)
}
freq
}
matchFloatFrequency <- function(freq = c( "Annual",
"Semiannual", "EveryFourthMonth",
"Quarterly", "Bimonthly", "Monthly")) {
if (!is.numeric(freq)){
freq <- match.arg(freq)
freq <- switch(freq,
Annual = 12,
Semiannual = 6, EveryFourthMonth = 4,
Quarterly = 3, Bimonthly = 2,
Monthly = 1)
}
freq
}
matchDateGen <- function(dg = c("Backward", "Forward", "Zero",
"ThirdWednesday", "Twentieth",
"TwentiethIMM", "OldCDS", "CDS")){
if (!is.numeric(dg)){
dg <- match.arg(dg)
dg <- switch(dg,
Backward = 0, Forward = 1,
Zero = 2, ThirdWednesday = 3,
Twentieth = 4, TwentiethIMM = 5, OldCDS=6, CDS=7)
}
dg
}
matchDurationType <- function(dt = c("Simple", "Macaulay", "Modified")) {
if (!is.numeric(dt)){
dt <- match.arg(dt)
dt <- switch(dt,
Simple = 0,
Macaulay = 1,
Modified = 2)
}
dt
}
matchParams <- function(params) {
if (!is.null(params$dayCounter)) {
params$dayCounter <- matchDayCounter(params$dayCounter)
}
if (!is.null(params$compounding)) {
params$compounding <- matchCompounding(params$compounding)
}
if (!is.null(params$period)) {
params$period <- matchFrequency(params$period)
}
if (!is.null(params$freq)) {
params$freq <- matchFrequency(params$freq)
}
if (!is.null(params$fixFreq)) {
params$fixFreq <- matchFrequency(params$fixFreq)
}
if (!is.null(params$floatFreq)) {
params$floatFreq <- matchFloatFrequency(params$floatFreq)
}
if (!is.null(params$businessDayConvention)) {
params$businessDayConvention <- matchBDC(params$businessDayConvention)
}
if (!is.null(params$terminationDateConvention)) {
params$terminationDateConvention <- matchBDC(params$terminationDateConvention)
}
if (!is.null(params$paymentConvention)) {
params$paymentConvention <- matchBDC(params$paymentConvention)
}
if (!is.null(params$exCouponConvention)) {
params$exCouponConvention <- matchBDC(params$exCouponConvention)
}
if (!is.null(params$dateGeneration)) {
params$dateGeneration <- matchDateGen(params$dateGeneration)
}
if (!is.null(params$fixedLegConvention)) {
params$fixedLegConvention <- matchBDC(params$fixedLegConvention)
}
if (!is.null(params$fixedLegDayCounter)) {
params$fixedLegDayCounter <- matchDayCounter(params$fixedLegDayCounter)
}
if (!is.null(params$durationType)) {
params$durationType <- matchDurationType(params$durationType)
}
params
}
# Generic methods
plot.Bond <- function(x, ...) {
warning("No plotting available for class", class(x)[1],"\n")
invisible(x)
}
print.Bond <- function(x, digits=5, ...) {
cat("Concise summary of valuation for", class(x)[1], "\n")
cat(" Net present value : ", format(x$NPV), "\n")
cat(" clean price : ", format(x$cleanPrice, digits=digits), "\n")
cat(" dirty price : ", format(x$dirtyPrice, digits=digits), "\n")
cat(" accrued coupon : ", format(x$accruedCoupon, digits=digits), "\n")
cat(" yield : ", format(x$yield, digits=digits), "\n")
cat(" cash flows : \n")
print(x$cashFlow, row.names=FALSE, digits=digits)
#print(round(unlist(x[1:5]), digits))
invisible(x)
}
print.FixedRateBond <- function(x, digits=5, ...) {
cat("Concise summary of valuation for", class(x)[1], "\n")
cat(" Net present value : ", format(x$NPV), "\n")
cat(" clean price : ", format(x$cleanPrice, digits=digits), "\n")
cat(" dirty price : ", format(x$dirtyPrice, digits=digits), "\n")
cat(" accrued coupon : ", format(x$accruedCoupon, digits=digits), "\n")
cat(" yield : ", format(x$yield, digits=digits), "\n")
cat(" duration : ", format(x$duration, digits=digits), "\n")
cat(" settlement date : ", format(x$settlementDate, format="%Y-%m-%d"), "\n")
cat(" cash flows : \n")
print(x$cashFlow, row.names=FALSE, digits=digits)
#print(round(unlist(x[1:5]), digits))
invisible(x)
}
summary.Bond <- function(object, digits=5, ...) {
cat("Detailed summary of valuation for", class(object)[1], "\n")
print(round(unlist(object[1:5]), digits))
cat("with parameters\n")
print(unlist(object[["parameters"]]))
invisible(object)
}
RQuantLib/R/calendars.R 0000644 0001762 0000144 00000017273 14140644011 014400 0 ustar ligges users ## RQuantLib -- R interface to the QuantLib libraries
##
## Copyright (C) 2002 - 2021 Dirk Eddelbuettel
## Copyright (C) 2010 Dirk Eddelbuettel and Khanh Nguyen
##
## This file is part of the RQuantLib library for GNU R.
## It is made available under the terms of the GNU General Public
## License, version 2, or at your option, any later version,
## incorporated herein by reference.
##
## This program 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 this program; if not, write to the Free
## Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
## MA 02111-1307, USA
calendars <- c("TARGET",
"UnitedStates",
"UnitedStates/LiborImpact",
"UnitedStates/NYSE",
"UnitedStates/GovernmentBond",
"UnitedStates/NERC",
"UnitedStates/FederalReserve",
"Argentina",
"Australia",
"Austria",
"Austria/Exchange",
"Bespoke",
"Botswana",
"Brazil",
"Brazil/Exchange",
"Canada",
"Canada/TSX",
"Chile",
"China",
"China/IB",
"CzechRepublic",
"Denmark",
"Finland",
"France",
"France/Exchange",
"Germany",
"Germany/FrankfurtStockExchange",
"Germany/Xetra",
"Germany/Eurex",
"Germany/Euwax",
"HongKong",
"Hungary",
"Iceland",
"India",
"Indonesia",
"Israel",
"Italy",
"Italy/Exchange",
"Japan",
"Mexico",
"NewZealand",
"Norway",
"Null",
"Poland",
"Romania",
"Russia",
"SaudiArabia",
"Singapore",
"Slovakia",
"SouthAfrica",
"SouthKorea",
"SouthKorea/KRX",
"Sweden",
"Switzerland",
"Taiwan",
"Thailand",
"Turkey",
"Ukraine",
"UnitedKingdom",
"UnitedKingdom/Exchange",
"UnitedKingdom/Metals",
"WeekendsOnly")
## isBusinessDay <- function(calendar="TARGET", dates=Sys.Date()) {
## stopifnot(is.character(calendar))
## stopifnot(class(dates)=="Date")
## val <- .Call("isBusinessDay", calendar, dates, PACKAGE="RQuantLib")
## val <- as.logical(val)
## names(val) <- dates
## val
## }
businessDay <- function(calendar="TARGET", dates=Sys.Date()) { ## may get deprecated one day
isBusinessDay(calendar, dates)
}
## isHoliday <- function(calendar="TARGET", dates=Sys.Date()) {
## stopifnot(is.character(calendar))
## stopifnot(class(dates)=="Date")
## val <- .Call("isHoliday", calendar, dates, PACKAGE="RQuantLib")
## val <- as.logical(val)
## names(val) <- dates
## val
## }
## isWeekend <- function(calendar="TARGET", dates=Sys.Date()) {
## stopifnot(is.character(calendar))
## stopifnot(class(dates)=="Date")
## val <- .Call("isWeekend", calendar, dates, PACKAGE="RQuantLib")
## val <- as.logical(val)
## names(val) <- dates
## val
## }
## isEndOfMonth <- function(calendar="TARGET", dates=Sys.Date()) {
## stopifnot(is.character(calendar))
## stopifnot(class(dates)=="Date")
## val <- .Call("isEndOfMonth", calendar, dates, PACKAGE="RQuantLib")
## val <- as.logical(val)
## names(val) <- dates
## val
## }
## getEndOfMonth <- function(calendar="TARGET", dates=Sys.Date()) {
## stopifnot(is.character(calendar))
## stopifnot(class(dates)=="Date")
## val <- .Call("endOfMonth", calendar, dates, PACKAGE="RQuantLib")
## names(val) <- dates
## val
## }
endOfMonth <- function(calendar="TARGET", dates=Sys.Date()) {
getEndOfMonth(calendar, dates)
}
## adjust <- function(calendar="TARGET", dates=Sys.Date(), bdc = 0 ) {
## stopifnot(is.character(calendar))
## stopifnot(class(dates)=="Date")
## val <- .Call("adjust", calendar, as.double(bdc), dates, PACKAGE="RQuantLib")
## names(val) <- dates
## val
## }
advance <- function(calendar="TARGET", dates=Sys.Date(),
n, timeUnit, # call 1
period, # call 2
bdc = 0, emr = 0) {
stopifnot(is.character(calendar))
stopifnot(class(dates)=="Date")
call1 <- missing(period) && !missing(n) && !missing(timeUnit)
call2 <- !missing(period) && missing(n) && missing(timeUnit)
stopifnot(call1 | call2)
val <- NULL
if (call1) {
## val <- .Call("advance1",
## calendar,
## list(amount = as.double(n),
## unit = as.double(timeUnit),
## bdc = as.double(bdc),
## emr = as.double(emr)),
## dates,
## PACKAGE="RQuantLib")
val <- advance1(calendar, n, timeUnit, bdc, emr, dates)
}
if (call2) {
## val <- .Call("advance2",
## calendar,
## list(period = as.double(period),
## bdc = as.double(bdc),
## emr = as.double(emr)),
## dates,
## PACKAGE="RQuantLib")
val <- advance2(calendar, period, bdc, emr, dates)
}
stopifnot( !is.null(val) )
val
}
## businessDaysBetween <- function(calendar="TARGET",
## from=Sys.Date(),
## to = Sys.Date() + 5,
## includeFirst = 1,
## includeLast = 0
## ) {
## stopifnot(is.character(calendar))
## stopifnot(class(from)=="Date")
## stopifnot(class(to)=="Date")
## val <- .Call("businessDaysBetween",
## calendar,
## list(includeFirst = as.double(includeFirst),
## includeLast = as.double(includeLast)),
## from, to,
## PACKAGE="RQuantLib")
## val <- val
## val
## }
## getHolidayList <- function(calendar="TARGET",
## from=Sys.Date(),
## to=Sys.Date() + 5,
## includeWeekends=0) {
## stopifnot(is.character(calendar))
## stopifnot(class(from)=="Date")
## stopifnot(class(to)=="Date")
## val <- .Call("holidayList",
## calendar,
## list(includeWeekends=as.double(includeWeekends), from=from, to=to),
## PACKAGE="RQuantLib")
## val
## }
holidayList <- function(calendar="TARGET", from=Sys.Date(), to=Sys.Date() + 5, includeWeekends=FALSE) {
getHolidayList(calendar, from, to, includeWeekends)
}
businessDayList <- function(calendar="TARGET", from=Sys.Date(), to=Sys.Date() + 5) {
getBusinessDayList(calendar, from, to)
}
#setCalendarContext <- function(calendar="TARGET",
# fixingDays = 2,
# settleDate = Sys.Date() + 2) {
# val <- .Call("setContext",
# list(calendar = calendar,
# fixingDays = fixingDays,
# settleDate = settleDate),
# PACKAGE="RQuantLib")
#}
RQuantLib/R/schedule.R 0000644 0001762 0000144 00000003207 12427163453 014244 0 ustar ligges users ## RQuantLib -- R interface to the QuantLib libraries
##
## Copyright (C) 2014 Michele Salvadore 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 .
Schedule <- function(params){
UseMethod("Schedule")
}
Schedule.default <- function(params) {
val <- 0
# check schedule params
if (is.null(params$effectiveDate)){
stop("schedule effective date undefined.")
}
if (is.null(params$maturityDate)){
stop("schedule maturity date undefined.")
}
if (is.null(params$period)) params$period <- 'Semiannual'
if (is.null(params$calendar)) params$calendar <- 'TARGET'
if (is.null(params$businessDayConvention)) params$businessDayConvention <- 'Following'
if (is.null(params$terminationDateConvention)) params$terminationDateConvention <- 'Following'
if (is.null(params$dateGeneration)) params$dateGeneration <- 'Backward'
if (is.null(params$endOfMonth)) params$endOfMonth <- 0
params <- matchParams(params)
CreateSchedule(params)
}
RQuantLib/R/asian.R 0000644 0001762 0000144 00000003736 14573064151 013551 0 ustar ligges users
## RQuantLib -- R interface to the QuantLib libraries
##
## Copyright (C) 2002 - 2014 Dirk Eddelbuettel
## Copyright (C) 2009 Khanh Nguyen
##
## 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 .
AsianOption <- function(averageType, type, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility,
first, length, fixings) {
UseMethod("AsianOption")
}
AsianOption.default <- function(averageType, type, underlying, strike, dividendYield,
riskFreeRate, maturity, volatility,
first=0, length=11.0/12.0, fixings=26) {
averageType <- match.arg(averageType, c("geometric", "arithmetic"))
type <- match.arg(type, c("call", "put"))
if (missing(maturity)) {
if (averageType=="geometric") {
warning("Geometric Asian Option requires maturity argument")
return(NULL)
} else {
maturity <- 1.0 # actually unused for arithmetic option case
}
}
val <- asianOptionEngine(averageType, type, underlying,
strike, dividendYield, riskFreeRate,
maturity, volatility,
first, length, fixings)
class(val) <- c("AsianOption","Option")
val
}
RQuantLib/R/datasets.R 0000644 0001762 0000144 00000001026 12750761663 014263 0 ustar ligges users #' Vol Cube Example Data
#'
#' Data for valuing swaption examples including rates and a lognormal vol cube
#'
#' @name vcube
#' @docType data
#' @usage data(vcube)
#' @format two data frames: \code{vcube}, a data frame with four columns: \code{Expiry}, \code{Tenor},
#' \code{LogNormalVol}, and \code{Spread}
#' @source TBA
NULL
#' Vol Cube Example Data
#'
#' Short time series examples
#'
#' @name tsQuotes
#' @docType data
#' @format A series of tenors and rates approppriate for calling DiscountCurve
#' @source TBA
NULL
RQuantLib/R/discount.R 0000644 0001762 0000144 00000010457 12714226467 014311 0 ustar ligges users ## RQuantLib function DiscountCurve
##
## Copyright (C) 2005 Dominick Samperi
## Copyright (C) 2007 - 2016 Dirk Eddelbuettel
## Copyright (C) 2009 - 2010 Dirk Eddelbuettel and Khanh Nguyen
##
## 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 .
DiscountCurve <- function(params, tsQuotes, times=seq(0,10,.1),
legparams=list(dayCounter="Thirty360",
fixFreq="Annual",
floatFreq="Semiannual")) {
UseMethod("DiscountCurve")
}
DiscountCurve.default <- function(params, tsQuotes, times=seq(0,10,.1),
legparams=list(dayCounter="Thirty360",
fixFreq="Annual",
floatFreq="Semiannual")) {
## Check that params is properly formatted.
if (!is.list(params) || length(params) == 0) {
stop("The params parameter must be a non-empty list", call.=FALSE)
}
## Check that the term structure quotes are properly formatted.
if (!is.list(tsQuotes) || length(tsQuotes) == 0) {
stop("Term structure quotes must be a non-empty list", call.=FALSE)
}
if (length(tsQuotes) != length(names(tsQuotes))) {
stop("Term structure quotes must include labels", call.=FALSE)
}
if (!is.numeric(unlist(tsQuotes))) {
stop("Term structure quotes must have numeric values", call.=FALSE)
}
## Check the times vector
if (!is.numeric(times) || length(times) == 0) {
stop("The times parameter must be a non-emptry numeric vector", call.=FALSE)
}
## Finally ready to make the call...
##val <- .Call("DiscountCurve", params, tsQuotes, times, PACKAGE="RQuantLib")
matchlegs<-matchParams(legparams)
##val <- discountCurveEngine(params, tsQuotes, times,matchCpnmonthFreq=as.integer(monthFreq))
val <- discountCurveEngine(params, tsQuotes, times,matchlegs)
val[["table"]] <- as.data.frame(val[["table"]]) ## Windows all of a sudden needs this
class(val) <- c("DiscountCurve")
val
}
plot.DiscountCurve <- function(x, setpar=TRUE, dolegend=TRUE,...) {
if (setpar) {
savepar <- par(mfrow=c(3,1))
}
if (x$flatQuotes) {
## Don't want to plot noise when we look at a flat yield curve
plot(c(x$times[1],x$times[length(x$times)]), c(0,.5),type='n',
main='forwards', xlab='time',ylab='forward rate')
lines(x$times, x$forwards, type='l')
if (dolegend) {
legend('center','center','flat',bty='n',text.col='red')
}
plot(c(x$times[1],x$times[length(x$times)]), c(0,.5),type='n',
main='zero rates', xlab='time',ylab='zero rate')
lines(x$times, x$zerorates, type='l')
if (dolegend) {
legend('center','center','flat',bty='n',text.col='red')
}
} else {
plot(x$times, x$forwards, type='l', main='forwards',xlab='time',ylab='fwd rate')
if (dolegend) {
legend('center','center',paste(x$params$interpHow, 'discount'), bty='n', text.col='red')
}
plot(x$times, x$zerorates, type='l', main='zero rates',xlab='time',ylab='zero rate')
if (dolegend) {
legend('center','center',paste(x$params$interpHow, 'discount'),bty='n', text.col='red')
}
}
plot(x$times, x$discounts, type='l', main='discounts',xlab='time',ylab='discount')
if (dolegend) {
if (x$flatQuotes) {
legend('center','center','flat',bty='n',text.col='red')
} else {
legend('center','center',paste(x$params$interpHow, 'discount'),bty='n', text.col='red')
}
}
if (setpar) {
par(savepar)
}
}
RQuantLib/R/bermudan.R 0000644 0001762 0000144 00000016616 14234647573 014265 0 ustar ligges users ## RQuantLib function BermudanSwaption
##
## Copyright (C) 2005 Dominick Samperi
## Copyright (C) 2007 - 2014 Dirk Eddelbuettel
## Copyright (C) 2016 Terry Leitch
##
## 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 .
BermudanSwaption <- function(params, ts, swaptionMaturities,
swapTenors, volMatrix) {
UseMethod("BermudanSwaption")
}
BermudanSwaption.default <- function(params, ts, swaptionMaturities,
swapTenors, volMatrix) {
# Check that params list names
if (!is.list(params) || length(params) == 0) {
stop("The params parameter must be a non-empty list", call.=FALSE)
}
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$maturity)){
params$maturity=advance("UnitedStates",params$startDate, 5, 3)
warning("swaption maturity not set, defaulting to 5 years from startDate using US calendar")
}
matYears=as.numeric(params$maturity-params$tradeDate)/365
expYears=as.numeric(params$startDate-params$tradeDate)/365
increment=min(matYears/6,1.0)
numObs=floor(matYears/increment)+1
optStart=as.numeric(params$startDate-params$tradeDate)/365
# find closest option to our target to ensure it is in calibration
tenor=expiry=vol=vector(length=numObs,mode="numeric")
expiryIDX=findInterval(expYears,swaptionMaturities)
tenorIDX=findInterval(matYears-expYears,swapTenors)
if(tenorIDX >0 & expiryIDX>0){
vol[1]=volMatrix[expiryIDX,tenorIDX]
expiry[1]=swaptionMaturities[expiryIDX]
tenor[1]=swapTenors[tenorIDX]
} else {
vol[1]=expiry[1]=tenor[1]=0
}
for(i in 2:numObs){
expiryIDX=findInterval(i*increment,swaptionMaturities)
tenorIDX=findInterval(matYears-(i-1)*increment,swapTenors)
if(tenorIDX >0 & expiryIDX>0){
vol[i]=volMatrix[expiryIDX,tenorIDX]
expiry[i]=swaptionMaturities[expiryIDX]
tenor[i]=swapTenors[tenorIDX]
} else {
vol[i]=volMatrix[expiryIDX,tenorIDX+1]
expiry[i]=swaptionMaturities[expiryIDX]
tenor[i]=swapTenors[tenorIDX+1]
}
}
# remove if search was out of bounds
expiry=expiry[expiry>0];tenor=tenor[tenor>0];vol=vol[vol>0]
if(length(expiry)<5){
warning("Insufficent vols to fit affine model")
return(NULL)
}
#Take 1st 5 which includes closest to initial date
expiry=expiry[1:5];tenor=tenor[1:5];vol=vol[1:5]
#
# Check that the term structure quotes are properly formatted.
# if(is)
# if (!is.list(ts) || length(ts) == 0) {
# stop("Term structure quotes must be a non-empty list", call.=FALSE)
# }
# if (length(ts) != length(names(ts))) {
# stop("Term structure quotes must include labels", call.=FALSE)
# }
# if (!is.numeric(unlist(ts))) {
# stop("Term structure quotes must have numeric values", call.=FALSE)
# }
# Check for correct matrix/vector types
if (!is.matrix(volMatrix)
|| !is.vector(swaptionMaturities)
|| !is.vector(swapTenors)) {
stop("Swaption vol must be a matrix, maturities/tenors must be vectors",
call.=FALSE)
}
# Check that matrix/vectors have compatible dimensions
if (prod(dim(volMatrix)) != length(swaptionMaturities)*length(swapTenors)) {
stop("Dimensions of swaption vol matrix not compatible with maturity/tenor vectors",
call.=FALSE)
}
# Finally ready to make the call...
# We could coerce types here and pass as.integer(round(swapTenors)),
# temp <- as.double(volMatrix), dim(temp) < dim(a) [and pass temp instead
# of volMatrix]. But this is taken care of in the C/C++ code.
if (inherits(ts, "DiscountCurve")) {
val <- bermudanWithRebuiltCurveEngine(params, c(ts$table$date), ts$table$zeroRates,
swaptionMaturities,
swapTenors, volMatrix)
} else{
if (!is.numeric(ts) | length(ts) !=1) {
stop("Flat Term structure yield must have single numeric value", call.=FALSE)
}
val <- bermudanFromYieldEngine(params, ts,
swaptionMaturities,
swapTenors, volMatrix)
}
class(val) <- c(params$method, "BermudanSwaption")
val
}
summary.G2Analytic <- function(object,...) {
cat('\n\tSummary of pricing results for Bermudan Swaption\n')
cat('\nPrice (in bp) of Bermudan swaption is ', object$price)
cat('\nStike is ', format(object$params$strike,digits=6))
cat(' (ATM strike is ', format(object$ATMStrike,digits=6), ')')
cat('\nModel used is: G2/Jamshidian using analytic formulas')
cat('\nCalibrated model parameters are:')
cat('\na = ', format(object$a,digits=4))
cat('\nb = ', format(object$b,digits=4))
cat('\nsigma = ', format(object$sigma,digits=4))
cat('\neta = ', format(object$eta,digits=4))
cat('\nrho = ', format(object$rho,digits=4))
cat('\n\n')
}
summary.HWAnalytic <- function(object,...) {
cat('\n\tSummary of pricing results for Bermudan Swaption\n')
cat('\nPrice (in bp) of Bermudan swaption is ', object$price)
cat('\nStike is ', format(object$params$strike,digits=6))
cat(' (ATM strike is ', format(object$ATMStrike,digits=6), ')')
cat('\nModel used is: Hull-White using analytic formulas')
cat('\nCalibrated model parameters are:')
cat('\na = ', format(object$a,digits=4))
cat('\nsigma = ', format(object$sigma,digits=4))
cat('\n\n')
}
summary.HWTree <- function(object,...) {
cat('\n\tSummary of pricing results for Bermudan Swaption\n')
cat('\nPrice (in bp) of Bermudan swaption is ', object$price)
cat('\nStike is ', format(object$params$strike,digits=6))
cat(' (ATM strike is ', format(object$ATMStrike,digits=6), ')')
cat('\nModel used is: Hull-White using a tree')
cat('\nCalibrated model parameters are:')
cat('\na = ', format(object$a,digits=4))
cat('\nsigma = ', format(object$sigma,digits=4))
cat('\n\n')
}
summary.BKTree <- function(object,...) {
cat('\n\tSummary of pricing results for Bermudan Swaption\n')
cat('\nPrice (in bp) of Bermudan swaption is ', object$price)
cat('\nStike is ', format(object$params$strike,digits=6))
cat(' (ATM strike is ', format(object$ATMStrike,digits=6), ')')
cat('\nModel used is: Black-Karasinski using a tree')
cat('\nCalibrated model parameters are:')
cat('\na = ', format(object$a,digits=4))
cat('\nsigma = ', format(object$sigma,digits=4))
cat('\n\n')
}
RQuantLib/R/inline.R 0000644 0001762 0000144 00000006075 12753434160 013732 0 ustar ligges users ## RQuantLib -- R interface to the QuantLib libraries
##
## Copyright (C) 2002 - 2016 Dirk Eddelbuettel
##
## This file is part of the RQuantLib library for GNU R.
## It is made available under the terms of the GNU General Public
## License, version 2, or at your option, any later version,
## incorporated herein by reference.
##
## This program 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 Rcpp. If not, see .
.pkgglobalenv <- new.env(parent=emptyenv())
.onLoad <- function(libname, pkgname) {
## default to NULL
qlcflags <- qllibs <- NULL
if (.Platform$OS.type=="windows") {
if (Sys.getenv("QUANTLIB_ROOT") != "") {
## by convention with CRAN, on Windows we expect these two
## variables to be set, and to be pointing to the respective
## helper installations
qlroot <- Sys.getenv("QUANTLIB_ROOT")
boostlib <- Sys.getenv("BOOSTLIB")
rarch <- Sys.getenv("R_ARCH")
qlcflags <- sprintf("-I%s -I. -I\"%s\"", qlroot, boostlib)
qllibs <- sprintf("-L%s/lib%s -lQuantLib", qlroot, rarch)
}
} else {
## on Linux and OS X, see if we have quantlib-config which may well be
## false in the case of prebuild binary packages as eg r-cran-rquantlib
## on Debian / Ubuntu as well as the OS X package from CRAN
## first we check whether we have quantlib-config in the path
if (isTRUE(unname(Sys.which("quantlib-config")) != "")) {
qc <- system("bash -c 'type -p quantlib-config'", ignore.stderr=TRUE, intern=TRUE)
if (is.character(qc) && nchar(qc) > 1) {
qlcflags <- system(paste(qc, "--cflags"), intern = TRUE)
qllibs <- system(paste(qc, "--libs"), intern = TRUE)
}
}
}
assign("ql_cflags", qlcflags, envir=.pkgglobalenv)
assign("ql_libs", qllibs, envir=.pkgglobalenv)
}
LdFlags <- function(print = TRUE) {
if (is.null(.pkgglobalenv$ql_libs)) stop("Cannot supply LdFlags as none set.")
if (print) cat(.pkgglobalenv$ql_libs) else .pkgglobalenv$ql_libs
}
CFlags <- function(print = TRUE) {
if (is.null(.pkgglobalenv$ql_cflags)) stop("Cannot supply CFlags as none set.")
if (print) cat(.pkgglobalenv$ql_cflags) else .pkgglobalenv$ql_cflags
}
inlineCxxPlugin <- function(...) {
plugin <- Rcpp.plugin.maker(include.before = "#include ",
libs = sprintf("%s $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS)", LdFlags(FALSE)),
package = "RQuantLib",
Makevars = NULL,
Makevars.win = NULL)
settings <- plugin()
settings$env$PKG_CPPFLAGS <- paste("-DRQuantLib_Plugin", CFlags(FALSE))
settings
}
RQuantLib/R/mod.R 0000644 0001762 0000144 00000000075 12271333436 013224 0 ustar ligges users
#loadModule("BondsMod", TRUE)
#loadModule("BlackMod", TRUE)
RQuantLib/cleanup 0000755 0001762 0000144 00000000503 14652452404 013474 0 ustar ligges users #!/bin/sh
Rscript -e 'library(Rcpp); compileAttributes(".")'
rm -rf config.log config.status confdefs.h autom4te.cache \
src/Makevars src/libRQuantLib.a src/libRQuantLib.def src/*.o src/*.so src/symbols.rds \
RcppSrc/*.a RcppSrc/*.o RcppSrc/config.* inst/Rcpp-version.txt
find . -name \*~ | xargs rm -f
exit 0
RQuantLib/demo/ 0000755 0001762 0000144 00000000000 14356056760 013053 5 ustar ligges users RQuantLib/demo/00Index 0000644 0001762 0000144 00000000172 12466654326 014207 0 ustar ligges users OptionSurfaces European Option surfaces (requires rgl)
ShinyDiscountCurves Shiny application with Discount Curve example
RQuantLib/demo/ShinyDiscountCurves.R 0000644 0001762 0000144 00000000462 12466654326 017175 0 ustar ligges users
## use shiny, if installed to show Shiny App installed with package
if (require("shiny")) {
library(RQuantLib)
runApp(system.file("shiny", "DiscountCurve", package="RQuantLib"),
port=8765
## add host="0.0.0.0" if access from outside current machine needed
)
}
RQuantLib/demo/OptionSurfaces.R 0000644 0001762 0000144 00000004757 14356056760 016157 0 ustar ligges users
## RQuantLib Demo for (European) Option surfaces
## Dirk Eddelbuettel, September 2005
## $Id: OptionSurfaces.R,v 1.1 2005/10/12 03:42:45 edd Exp $
OptionSurface <- function(EOres, label, fov=60) {
#
# This can be removed when rgl 0.111.5 is released:
if (packageVersion("rgl") < "0.111.5")
surface3d <- rgl.surface
# End of old workaround
axis.col <- "black"
text.col <- axis.col
ylab <- label
xlab <- "Underlying"
zlab <- "Volatility"
y <- EOres
## clear scene:
clear3d()
clear3d(type="bbox")
clear3d(type="lights")
## setup env:
## bg3d(color="#887777")
bg3d(color="#DDDDDD")
light3d()
view3d(fov=fov)
##bg3d(col="white", fogtype="exp2")
##bg3d(col="black", fogtype="exp2")
##bg3d(col="black", fogtype="exp")
##bg3d(col="white", fogtype="exp")
x <- (1:nrow(y))
z <- (1:ncol(y))
x <- (x-min(x))/(max(x)-min(x))
y <- (y-min(y))/(max(y)-min(y))
z <- (z-min(z))/(max(z)-min(z))
surface3d(x = x, y = y, z = z, alpha=0.6, lit=TRUE, color="blue")
lines3d(c(0,1), c(0,0), c(0,0), col=axis.col)
lines3d(c(0,0), c(0,1), c(0,0), col=axis.col)
lines3d(c(0,0),c(0,0), c(0,1), col=axis.col)
text3d(1,0,0, xlab, adj=1, col=text.col)
text3d(0,1,0, ylab, adj=1, col=text.col)
text3d(0,0,1, zlab, adj=1, col=text.col)
## add grid (credit's to John Fox scatter3d)
xgridind <- round(seq(1, nrow(y), length=25))
zgridind <- round(seq(1, ncol(y), length=25))
surface3d(x = x[xgridind], y = y[xgridind,zgridind], z = z[zgridind],
color="darkgray", alpha=0.5, lit=TRUE,
front="lines", back="lines")
## animate (credit to view3d() example)
start <- proc.time()[3]
while ((i <- 36*(proc.time()[3]-start)) < 360) {
view3d(i,i/8);
}
}
RQuantLib.demo.OptionSurfaces <- function() {
und.seq <- seq(10, 200, by = 2.5)
vol.seq <- seq(0.05, 2, by = 0.025)
cat("Calculating surface ...")
EOarr <- EuropeanOptionArrays("call", underlying = und.seq, strike = 100,
dividendYield = 0.01, riskFreeRate = 0.03,
maturity = 1, volatility = vol.seq)
cat(" done.\n")
open3d()
OptionSurface(EOarr$value, "Value")
OptionSurface(EOarr$delta, "Delta")
OptionSurface(EOarr$gamma, "Gamma")
OptionSurface(EOarr$vega, "Vega")
OptionSurface(EOarr$theta, "Theta")
}
require(rgl,quiet=TRUE)
require(RQuantLib,quiet=TRUE)
RQuantLib.demo.OptionSurfaces()
RQuantLib/data/ 0000755 0001762 0000144 00000000000 13376525200 013027 5 ustar ligges users RQuantLib/data/vcube.RData 0000644 0001762 0000144 00000013601 14652452404 015054 0 ustar ligges users ‹ í\”UÚf¤¨ˆbF‚AÄp3JDÝÑ@PTVD³XD]ż¬9-f]E]„IÝ]U]Õ¹ªÃDÒ ‚ŠÂ¾÷úVÍ¿ðûŸ³³?çˆôœó˜žž®W/Üï~÷»¯†Qç]Ñ·ímóòòòó
[ä列…ùâŸy…ymÄ÷–7Mš=±8/¯à@ùñ½ƒxêÿyËß
°ånhšÑZ7£íӌ֦m3Z»f´öÍhšÑrÏa<‡ñ_/ÆwGäbä¿‘\í91”‹\žøc<—'~1’‹¡='†r1Ë9Œç0žÃø¿¤JŠo*.™)^uT¿Í¾[Ч÷8¾Ìï3Ü{å½××{ÕÏûm?ï½S½Wý½W¼Ï
ðÞ;Í{5Ð{uú¸ÜI%E3Ýñy£žR4iÖŒRñjûééæZ®íImwäš\˵_SÛ5r®åÚÞÔv‡'”k¹ökj»£v͵\Û›Zs¼š\˵=©5Ç[̵\Ûƒš´Lówäe]ÒÖy»¸¸}š¬XÏÆ-èÛ{WG· _ïÿiߪžÜžÿWÿ5Où¯;vì(Úõ¢=%Ú
Ñ*E«ÉË~u¯hÃD›,Úc¢}óK׈¶V´FѶˆ¶}È|%½õýDëôŸöÙœqìmcÏ]“ÃÉo}ì¹kölœìÍ}îm{ýkžon]ÛcÏ]³gãdoîsoÛë_ó|sëúÛ{îšN~ëcÏ]ó_#Ú¾ÒEõ-?iñÂt$´/‹|)BþgTôÿÌw¶=mÂ6g\wÞµ¡ßrVhÞÄ÷¡ýê€[÷{ù©+nJÕ9›0áûðØçŸºùIøN>sÙÚ¼J£ê•ŠeBÅçnŸðˆÞF9”ÖÏãûQc~ÿÊä/Qú'×^Ùýާ/Ûž½åç®;8<ÐøòOˆ,úvøõDØ—ùý9÷ž†ð ÝÚÍ)¸¡?¿yi‡?
G¨Keëkf`½³¤Îyë>X¼Î:îê>ß?SÞuÄ™03«è”úÖ m·?¼c)BsìR‰ÈÕOê'Ÿ…øEµË¨þìǯiµåÏxã\Ÿý™Öß»ª|2’³» í_/}Oå
ƒ¶ÍCü°}žÌŸ}"e:qÕ«e<Ö[›nKóýºý~(½¦ìeæ¿~ÒQ÷ÁØÑKÜñÈÁ-~´ªcÙ‰¨Ïó¿ðI¤ù鲋:o„Ón¿ã?>e-â
‡Ÿ{òK·"zíÀ#þø‹·ÉÃZùýiþT˜7]c½þê3ŠÑÜþHŒ¦÷zû«~ÐÏúäúÛ„ÞB½áÍgóÔ6ú’Cz öo_ŒY½p#Òr—®ü±‰bg—Ýö{
ñóŸ[óù‚Sßf Öæ>pû ˆÎŸ‘75ò ¢üà£Uû#²´Û¬Ñ‹¾ED ááÇ>A8©Œð½?ë°îD„ÕtÛ ôNÏ}ÇvAè]ßÜ?ˆ!ÜéVçÂ7:!2ôØÓ?oXèc?¾*y'6«ÛtCÍ!'‰ö…#г ݉ēÇþbjù{#Üøò¶š’ûRpûÌ×nlÿÎ’zç”3µC,Ö¼²G¡¿Ç©Ó¾B{Z
"Ç(aãÒ/]"sЊ™õïN…½ðîű¥[çþE–ÌoÕ-v
BOȯ'an¾û§}A–3—ƒAüèÈ@ qørõú²m8òR±3o`]QzkñÏ÷#µê–¿®h·r[~ˆ º"úOt: ᛾ù»XO_<òΗÃì¤*l¤¡sŸ51Ùs—̇vjð9Ñ%ýžÚ÷³Ä‹ð/ÝÒãúÃÛßF–/E5ã.Åy;g) #žÝnDÇÊ<ƒðCNønåC•^xþÀ
ýaé?ûÞùÏÃz¸§Ýá°a!¹‡>‹ú%pîB’óŽ 4ôDDd4¶8¡A¾Ðrtw˜jÙOGP âãÇ¿ˆˆ9ZòÎÁbK qž’ÍGuíy3ü\OߺG¦–¾Õµ§CÜD—(@ Ìy[Š^®D83x_ý üyÐN¼z™M¦¨/ø¹þ¾š‚7߯ëy¢æmü»ÿG úþ×nDä.EDa®ÉL˜W•Oj<çh2¦?] Wì´kŸý¡Í>Bà¹q¯ÀÿUß5¿[~7ü=oîóÐ×-áSá4 U"ˆÇ>T‹ßÞµòxØê6–¨½ìmX
Çø›pÕùîùí‡6áIÁc"ü
ü`äZøû«@…ï¥[%ÒQE~©Tô;iÉF´Cl¥ÜØ/a‰Mœ½è‰kûPaY ??ç«T_aýÐŽJÞ·‚8,WÓ´$Ö<¼mhynÍÈ(šš‡ãsyÂ’0xL9ü†…
V~öá^Žºy£u>Œøu¯ùr
…bIa–þD»º‚ùèÏË
·¡ß®ˆ:×O'ߊþ†yAôªI÷LAXFÔ*Dyý–WŸ¹ü/gíƒÚ6
¨p™¨DâëB1Âëe¾
_rʂۆKd¥•ßD