[Rquantlib-commits] r332 - pkg/QuantLib/demo
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 3 02:42:49 CEST 2013
Author: edd
Date: 2013-06-03 02:42:48 +0200 (Mon, 03 Jun 2013)
New Revision: 332
Added:
pkg/QuantLib/demo/bates.R
pkg/QuantLib/demo/bonds.R
Log:
new bonds.R derived from bonds.py in the Python examples for QuantLib's SWIG bindings
new bates.R model demo by Klaus (as emailed to me)
Added: pkg/QuantLib/demo/bates.R
===================================================================
--- pkg/QuantLib/demo/bates.R (rev 0)
+++ pkg/QuantLib/demo/bates.R 2013-06-03 00:42:48 UTC (rev 332)
@@ -0,0 +1,50 @@
+
+## Bates mode demo by Klaus Spanderen
+
+library(lattice)
+suppressMessages(library(QuantLib))
+
+todaysDate <- Date(18, "May", 2013)
+Settings_instance()$setEvaluationDate(d=todaysDate)
+settlementDate <- Date(18, "May", 2013)
+
+riskFreeRate <- YieldTermStructureHandle(FlatForward(settlementDate, 0.01, Actual365Fixed()))
+
+dividendYield <- YieldTermStructureHandle(FlatForward(settlementDate, 0.04, Actual365Fixed()))
+
+underlying <- QuoteHandle(SimpleQuote(100))
+
+bsProcess <- BlackScholesMertonProcess(underlying, dividendYield, riskFreeRate,
+ BlackVolTermStructureHandle(
+ BlackConstantVol(todaysDate, TARGET(),
+ QuoteHandle(SimpleQuote(0.25)),
+ Actual365Fixed())))
+
+strikes <- seq(20, 200, length=30)
+maturities <- seq(0.25, 2, length=30)
+g <- expand.grid(strikes=strikes, maturities=maturities)
+
+batesEngine <- BatesEngine(BatesModel(BatesProcess(
+ riskFreeRate, dividendYield, underlying,
+ 0.1, 1.5, 0.25, 0.75, -0.75, 0.75, -0.05, 0.3)), 128)
+
+impliedVol <- function(strike, maturity) {
+ exercise <- EuropeanExercise(Date(18, "May", 2013) +
+ Period(maturity*365, "Days"))
+ payoff <- PlainVanillaPayoff("Call", strike)
+ option <- VanillaOption(payoff, exercise)
+ option$setPricingEngine(option, batesEngine)
+
+ option$impliedVolatility(option, targetValue=option$NPV(),
+ process=bsProcess, accuracy=1e-16,
+ maxEvaluations=100, minVol=0.1,maxVol=5.1)
+}
+
+g$vol <- mapply(impliedVol, g$strikes, g$maturities)
+
+newcols <- colorRampPalette(c("grey90", "grey10"))
+print(wireframe(vol ~ strikes*maturities, g,
+ xlab="Strike",ylab="Maturitiy",zlab="Vol",
+ drape=TRUE,col.regions=rainbow(100,end=0.99,alpha=0.9),
+ screen = list(z = -25, x = -65),scale=list(arrows=FALSE)))
+
Added: pkg/QuantLib/demo/bonds.R
===================================================================
--- pkg/QuantLib/demo/bonds.R (rev 0)
+++ pkg/QuantLib/demo/bonds.R 2013-06-03 00:42:48 UTC (rev 332)
@@ -0,0 +1,297 @@
+## bonds.R -- following what bonds.py does for the QuantLib bindings for Python
+
+suppressMessages(library(QuantLib))
+
+## global data
+calendar <- TARGET()
+
+settlementDate <- Date(18, "September", 2008)
+settlementDate <- Calendar_adjust(calendar, settlementDate)
+
+fixingDays <- 3
+settlementDays <- 3
+todaysDate <- Calendar_advance(calendar, settlementDate, -fixingDays, "Days")
+#Settings_setEvaluationDate(Settings_instance(), todaysDate)
+Settings_instance()$setEvaluationDate(d=todaysDate)
+
+cat('Today :'); print(todaysDate)
+cat('Settlement Date: '); print(settlementDate)
+
+## market quotes
+## constructing bond yield curve
+zcQuotes <- list(rates=c(0.0096, 0.0145, 0.0194),
+ tenor=c(Period(3, "Months"),
+ Period(6, "Months"),
+ Period(1, "Years")))
+
+zcBondsDayCounter <- Actual365Fixed()
+
+bondInstruments <- RateHelperVector()
+
+for (i in 1:3) {
+ r <- zcQuotes[["rates"]][i]
+ tenor <- zcQuotes[["tenor"]][[i]]
+ drh <- DepositRateHelper(QuoteHandle(SimpleQuote(r)),
+ tenor,
+ fixingDays,
+ calendar,
+ "ModifiedFollowing",
+ TRUE,
+ zcBondsDayCounter)
+ RateHelperVector_push_back(bondInstruments, drh)
+}
+#cat("Zeros done\n")
+
+## setup bonds
+redemption <- 100.0
+numberOfBonds <- 5
+
+bondQuotes <- list(list(Date(15,"March",2005),
+ Date(31,"August",2010),
+ 0.02375, 100.390625),
+ list(Date(15,"June",2005),
+ Date(31,"August",2011),
+ 0.04625, 106.21875),
+ list(Date(30,"June",2006),
+ Date(31,"August",2013),
+ 0.03125, 100.59375),
+ list(Date(15,"November",2002),
+ Date(15,"August",2018),
+ 0.04000, 101.6875),
+ list(Date(15,"May",1987),
+ Date (15,"May",2038),
+ 0.04500, 102.140625)
+ )
+
+# Definition of the rate helpers
+
+for (i in 1:5) {
+ issueDate <- bondQuotes[[i]][[1]]
+ maturity <- bondQuotes[[i]][[2]]
+ couponRate <- bondQuotes[[i]][[3]]
+ marketQuote <- bondQuotes[[i]][[4]]
+ schedule <- Schedule(issueDate, maturity, Period("Semiannual"),
+ UnitedStates("GovernmentBond"),
+ "Unadjusted", "Unadjusted",
+ copyToR(DateGeneration(), "Backward"),
+ FALSE)
+ vec <- DoubleVector(1)
+ vec[1] <- couponRate
+ bh <- FixedRateBondHelper(QuoteHandle(SimpleQuote(marketQuote)),
+ settlementDays,
+ 100.0,
+ schedule,
+ vec,
+ ActualActual("Bond"),
+ "Unadjusted",
+ redemption,
+ issueDate)
+ RateHelperVector_push_back(bondInstruments, bh)
+}
+
+termStructureDayCounter <- ActualActual("ISDA")
+
+# not needed as defined in the interface file: tolerance = 1.0e-15
+
+bondDiscountingTermStructure <- PiecewiseFlatForward(settlementDate,
+ bondInstruments,
+ termStructureDayCounter)
+#cat("Bond Discounting TermStructure set\n")
+
+
+# Building of the Libor forecasting curve
+# deposits
+dQuotes <- list(list(0.043375, Period(1,"Weeks")),
+ list(0.031875, Period(1,"Months")),
+ list(0.0320375, Period(3,"Months")),
+ list(0.03385, Period(6,"Months")),
+ list(0.0338125, Period(9,"Months")),
+ list(0.0335125, Period(1,"Years")))
+sQuotes <- list(list(0.0295, Period(2,"Years")),
+ list(0.0323, Period(3,"Years")),
+ list(0.0359, Period(5,"Years")),
+ list(0.0412, Period(10,"Years")),
+ list(0.0433, Period(15,"Years")))
+
+## deposits
+depositDayCounter <- Actual360()
+depoSwapInstruments <- RateHelperVector()
+
+for (i in 1:length(dQuotes)) {
+ rate <- dQuotes[[i]][[1]]
+ tenor <- dQuotes[[i]][[2]]
+ drh <- DepositRateHelper(QuoteHandle(SimpleQuote(rate)),
+ tenor, fixingDays,
+ calendar, "ModifiedFollowing",
+ TRUE, depositDayCounter)
+ RateHelperVector_push_back(depoSwapInstruments, drh)
+}
+
+
+## swaps
+swFixedLegFrequency <- "Annual"
+swFixedLegConvention <- "Unadjusted"
+swFixedLegDayCounter <- Thirty360("European")
+swFloatingLegIndex <- Euribor6M()
+forwardStart <- Period(1,"Days")
+for (i in 1:length(sQuotes)) {
+ rate <- sQuotes[[i]][[1]]
+ tenor <- sQuotes[[i]][[2]]
+ srh <- SwapRateHelper(QuoteHandle(SimpleQuote(rate)), tenor,
+ calendar, swFixedLegFrequency,
+ swFixedLegConvention, swFixedLegDayCounter,
+ swFloatingLegIndex, QuoteHandle(),forwardStart)
+ RateHelperVector_push_back(depoSwapInstruments, srh)
+}
+#cat("Deposit + Swap TermStructure set\n")
+
+depoSwapTermStructure <- PiecewiseFlatForward(settlementDate, depoSwapInstruments,
+ termStructureDayCounter)
+
+## Term structures that will be used for pricing:
+## the one used for discounting cash flows
+
+discountingTermStructure <- RelinkableYieldTermStructureHandle()
+
+## the one used for forward rate forecasting
+forecastingTermStructure <- RelinkableYieldTermStructureHandle()
+
+
+########################################
+## BONDS TO BE PRICED #
+########################################
+
+## common data
+
+faceAmount <- 100
+
+## pricing engine
+bondEngine <- DiscountingBondEngine(discountingTermStructure)
+
+## zero coupon bond
+zeroCouponBond <- ZeroCouponBond(settlementDays,
+ UnitedStates("GovernmentBond"),
+ faceAmount,
+ Date(15,"August",2013),
+ "Following",
+ 116.92,
+ Date(15,"August",2003))
+
+Instrument_setPricingEngine(zeroCouponBond, bondEngine)
+
+
+## fixed 4.5% US Treasury note
+
+fixedBondSchedule <- Schedule(Date(15, "May", 2007),
+ Date(15, "May",2017), Period("Semiannual"),
+ UnitedStates("GovernmentBond"),
+ "Unadjusted", "Unadjusted",
+ copyToR(DateGeneration(), "Backward"), FALSE)
+
+vec <- DoubleVector()
+DoubleVector_push_back(vec, 0.045)
+fixedRateBond <- FixedRateBond(settlementDays,
+ faceAmount,
+ fixedBondSchedule,
+ vec, ##[0.045],
+ ActualActual("Bond"),
+ "ModifiedFollowing",
+ 100.0, Date(15, "May", 2007))
+
+Instrument_setPricingEngine(fixedRateBond, bondEngine)
+
+
+## Floating rate bond (3M USD Libor + 0.1%)
+## Should and will be priced on another curve later...
+
+liborTermStructure <- RelinkableYieldTermStructureHandle()
+
+libor3m <- USDLibor(Period(3,"Months"),liborTermStructure)
+Index_addFixing(libor3m, Date(17, "July", 2008), 0.0278625)
+
+floatingBondSchedule <- Schedule(Date(21, "October", 2005),
+ Date(21, "October", 2010), Period("Quarterly"),
+ UnitedStates("NYSE"),
+ "Unadjusted", "Unadjusted",
+ copyToR(DateGeneration(), "Backward"), TRUE)
+
+gearings <- DoubleVector()
+DoubleVector_push_back(gearings, 1.0)
+spreads <- DoubleVector()
+DoubleVector_push_back(spreads, 0.001)
+
+floatingRateBond <- FloatingRateBond(settlementDays,
+ faceAmount,
+ floatingBondSchedule,
+ libor3m,
+ Actual360(),
+ "ModifiedFollowing",
+ 2,
+ gearings, #[1.0], # Gearings
+ spreads, #[0.001], # Spreads
+ DoubleVector(), #[], # Caps
+ DoubleVector(), #[], # Floors
+ TRUE, # Fixing in arrears
+ 100.0,
+ Date(21, "October", 2005))
+
+Instrument_setPricingEngine(floatingRateBond, bondEngine)
+
+## coupon pricers
+
+pricer <- BlackIborCouponPricer()
+
+## optionlet volatilities
+volatility <- 0.0
+vol <- ConstantOptionletVolatility(settlementDays,
+ calendar,
+ "ModifiedFollowing",
+ volatility,
+ Actual365Fixed())
+
+IborCouponPricer_setCapletVolatility(pricer, OptionletVolatilityStructureHandle(vol))
+setCouponPricer(Bond_cashflows(floatingRateBond), pricer)
+
+
+## Yield curve bootstrapping
+RelinkableQuoteHandle_linkTo(forecastingTermStructure, depoSwapTermStructure)
+RelinkableQuoteHandle_linkTo(discountingTermStructure, bondDiscountingTermStructure)
+
+## We are using the depo & swap curve to estimate the future Libor rates
+RelinkableQuoteHandle_linkTo(liborTermStructure, depoSwapTermStructure)
+
+##
+df <- data.frame(zeroCoupon=c(Instrument_NPV(zeroCouponBond),
+ Bond_cleanPrice(zeroCouponBond),
+ Bond_dirtyPrice(zeroCouponBond),
+ Bond_accruedAmount(zeroCouponBond),
+ NA,
+ NA),
+ fixedRate=c(Instrument_NPV(fixedRateBond),
+ Bond_cleanPrice(fixedRateBond),
+ Bond_dirtyPrice(fixedRateBond),
+ Bond_accruedAmount(fixedRateBond),
+ Bond_previousCouponRate(fixedRateBond),
+ Bond_nextCouponRate(fixedRateBond)),
+ floatingRate=c(Instrument_NPV(floatingRateBond),
+ Bond_cleanPrice(floatingRateBond),
+ Bond_dirtyPrice(floatingRateBond),
+ Bond_accruedAmount(floatingRateBond),
+ Bond_previousCouponRate(floatingRateBond),
+ Bond_nextCouponRate(floatingRateBond)),
+ row.names=c("NPV", "Clean Price", "Dirty Price",
+ "Accrued Amount", "Previous Coupon", "Next Coupon"))
+cat("\nResults:\n")
+print(df)
+
+# Other computations
+
+cat("\nSample indirect computations (for the floating rate bond):\n")
+cat("Yield to Clean Price: ")
+yld <- Bond_yield(floatingRateBond, Actual360(), "Compounded", "Annual")
+cleanPrice <- Bond_cleanPrice(floatingRateBond, yld, Actual360(), "Compounded", "Annual", settlementDate)
+print(cleanPrice)
+
+cat("Clean Price to Yield: ")
+yld <- Bond_yield(floatingRateBond, cleanPrice, Actual360(), "Compounded", "Annual",settlementDate)
+print(yld)
More information about the Rquantlib-commits
mailing list