From noreply at r-forge.r-project.org Mon Jun 3 02:42:49 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 3 Jun 2013 02:42:49 +0200 (CEST) Subject: [Rquantlib-commits] r332 - pkg/QuantLib/demo Message-ID: <20130603004249.49096184FED@r-forge.r-project.org> 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) From noreply at r-forge.r-project.org Mon Jun 3 14:43:47 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 3 Jun 2013 14:43:47 +0200 (CEST) Subject: [Rquantlib-commits] r333 - pkg/QuantLib/demo Message-ID: <20130603124347.6976E18505B@r-forge.r-project.org> Author: edd Date: 2013-06-03 14:43:47 +0200 (Mon, 03 Jun 2013) New Revision: 333 Modified: pkg/QuantLib/demo/bonds.R Log: add yield to final result set Modified: pkg/QuantLib/demo/bonds.R =================================================================== --- pkg/QuantLib/demo/bonds.R 2013-06-03 00:42:48 UTC (rev 332) +++ pkg/QuantLib/demo/bonds.R 2013-06-03 12:43:47 UTC (rev 333) @@ -266,23 +266,26 @@ Bond_dirtyPrice(zeroCouponBond), Bond_accruedAmount(zeroCouponBond), NA, - NA), + NA, + 100*Bond_yield(zeroCouponBond, Actual360(), "Compounded", "Annual")), fixedRate=c(Instrument_NPV(fixedRateBond), Bond_cleanPrice(fixedRateBond), Bond_dirtyPrice(fixedRateBond), Bond_accruedAmount(fixedRateBond), - Bond_previousCouponRate(fixedRateBond), - Bond_nextCouponRate(fixedRateBond)), + 100*Bond_previousCouponRate(fixedRateBond), + 100*Bond_nextCouponRate(fixedRateBond), + 100*Bond_yield(fixedRateBond, Actual360(), "Compounded", "Annual")), floatingRate=c(Instrument_NPV(floatingRateBond), Bond_cleanPrice(floatingRateBond), Bond_dirtyPrice(floatingRateBond), Bond_accruedAmount(floatingRateBond), - Bond_previousCouponRate(floatingRateBond), - Bond_nextCouponRate(floatingRateBond)), + 100*Bond_previousCouponRate(floatingRateBond), + 100*Bond_nextCouponRate(floatingRateBond), + 100*Bond_yield(floatingRateBond, Actual360(), "Compounded", "Annual")), row.names=c("NPV", "Clean Price", "Dirty Price", - "Accrued Amount", "Previous Coupon", "Next Coupon")) + "Accrued Amount", "Previous Coupon", "Next Coupon", "Yield")) cat("\nResults:\n") -print(df) +print(df, digits=5) # Other computations From noreply at r-forge.r-project.org Wed Jun 5 04:51:26 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Wed, 5 Jun 2013 04:51:26 +0200 (CEST) Subject: [Rquantlib-commits] r334 - pkg/QuantLib/demo Message-ID: <20130605025126.BE8BF184F68@r-forge.r-project.org> Author: edd Date: 2013-06-05 04:51:26 +0200 (Wed, 05 Jun 2013) New Revision: 334 Modified: pkg/QuantLib/demo/europeanOption.R Log: expanded to match Python example; includes correction to MCEuropeanEngine which comes out wrong from SWIG Modified: pkg/QuantLib/demo/europeanOption.R =================================================================== --- pkg/QuantLib/demo/europeanOption.R 2013-06-03 12:43:47 UTC (rev 333) +++ pkg/QuantLib/demo/europeanOption.R 2013-06-05 02:51:26 UTC (rev 334) @@ -1,17 +1,119 @@ + +## expanded to follow european-option.py + +suppressMessages(library(QuantLib)) + +# global data todaysDate <- Date(15, "May", 1998) -Settings_instance()$setEvaluationDate(d=todaysDate) +invisible(Settings_instance()$setEvaluationDate(d=todaysDate)) settlementDate <- Date(17, "May", 1998) riskFreeRate <- FlatForward(settlementDate, 0.05, Actual365Fixed()) + +# option parameters exercise <- EuropeanExercise(Date(17, "May", 1999)) payoff <- PlainVanillaPayoff("Call", 8.0) + +# market data underlying <- SimpleQuote(7.0) volatility <- BlackConstantVol(todaysDate, TARGET(), 0.10, Actual365Fixed()) dividendYield <- FlatForward(settlementDate, 0.05, Actual365Fixed()) + process <- BlackScholesMertonProcess(QuoteHandle(underlying), - YieldTermStructureHandle(dividendYield), - YieldTermStructureHandle(riskFreeRate), - BlackVolTermStructureHandle(volatility)) + YieldTermStructureHandle(dividendYield), + YieldTermStructureHandle(riskFreeRate), + BlackVolTermStructureHandle(volatility)) + +cat(sprintf("%17s %8s %6s %6s\n", "method", "value", "errest", "error")) +cat(rep("=", 43), "\n", sep="") +report <- function(method, x, dx=NA) { + err <- abs(x - refValue) # refValue is a global + cat(sprintf("%17s %8.5f %6.4f %6.4f\n", method, x, dx, err)) + invisible(NULL) +} + option <- VanillaOption(payoff, exercise) -option$setPricingEngine(s_arg2=AnalyticEuropeanEngine(process)) +invisible(option$setPricingEngine(option, AnalyticEuropeanEngine(process))) value <- option$NPV() -value +refValue <- value +report("analytic", value) + +invisible(option$setPricingEngine(option, IntegralEngine(process))) +report('integral', option$NPV()) + + +## method: finite differences +timeSteps <- 801 +gridPoints <- 800 + +invisible(option$setPricingEngine(option, FDEuropeanEngine(process,timeSteps,gridPoints))) +report('finite diff.', option$NPV()) + + +## method: binomial +timeSteps <- 801 + +invisible(option$setPricingEngine(option, BinomialVanillaEngine(process,'jr',timeSteps))) +report('binomial (JR)', option$NPV()) + +invisible(option$setPricingEngine(option, BinomialVanillaEngine(process,'crr',timeSteps))) +report('binomial (CRR)', option$NPV()) + +invisible(option$setPricingEngine(option, BinomialVanillaEngine(process,'eqp',timeSteps))) +report('binomial (EQP)', option$NPV()) + +invisible(option$setPricingEngine(option, BinomialVanillaEngine(process,'trigeorgis',timeSteps))) +report('bin. (Trigeorgis)', option$NPV()) + +invisible(option$setPricingEngine(option, BinomialVanillaEngine(process,'tian',timeSteps))) +report('binomial (Tian)', option$NPV()) + +invisible(option$setPricingEngine(option, BinomialVanillaEngine(process,'lr',timeSteps))) +report('binomial (LR)', option$NPV()) + +## method: finite differences +## not yet implemented + +MCEuropeanEngine <- function(process, traits, timeSteps, timeStepsPerYear=NA, + brownianBridge=FALSE, antitheticVariate=FALSE, + requiredSamples=NULL, + requiredTolerance=1.0e-3, maxSamples=NULL, seed=0L) { + traits <- as(traits, "character") + timeSteps <- as.integer(timeSteps) ##as(input, "integer"); + timeStepsPerYear <- as.integer(timeStepsPerYear) ##as(input, "integer"); + brownianBridge <- as.logical(brownianBridge) + antitheticVariate <- as.logical(antitheticVariate) + requiredSamples <- as.integer(requiredSamples) ##as(input, "integer"); + requiredTolerance <- as.numeric(requiredTolerance) ##as(input, "numeric"); + maxSamples <- as.integer(maxSamples) ##as(input, "integer"); + seed <- as.integer(seed) + if (length(seed) > 1) { + warning("using only the first element of seed") + } + + ans <- .Call('R_swig_new_MCEuropeanEngine', + process, traits, timeSteps, + timeStepsPerYear, brownianBridge, + antitheticVariate, requiredSamples, + requiredTolerance, maxSamples, seed, + PACKAGE='QuantLib') + class(ans) <- "_p_MCEuropeanEnginePtr" + + reg.finalizer(ans, delete_MCEuropeanEngine) + ans +} + + +## method: Monte Carlo +invisible(option$setPricingEngine(option, MCEuropeanEngine(process, + 'pseudorandom', + timeSteps = 1, + requiredTolerance = 0.02, + seed = 42))) +report('MC (crude)', option$NPV(), option$errorEstimate()) + +invisible(option$setPricingEngine(option, MCEuropeanEngine(process, + 'lowdiscrepancy', + timeSteps = 1, + requiredSamples = 32768))) +report('MC (Sobol)', option$NPV()) +