[Rquantlib-commits] r257 - in pkg/RQuantLib: R src src/unused
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Jun 17 13:49:52 CEST 2010
Author: edd
Date: 2010-06-17 13:49:51 +0200 (Thu, 17 Jun 2010)
New Revision: 257
Added:
pkg/RQuantLib/src/unused/
pkg/RQuantLib/src/unused/cbond.cpp
pkg/RQuantLib/src/unused/coupon.cpp
Removed:
pkg/RQuantLib/src/MFcoupon.cpp
Modified:
pkg/RQuantLib/R/bond.R
pkg/RQuantLib/R/discount.R
pkg/RQuantLib/src/curves.cpp
pkg/RQuantLib/src/discount.cpp
pkg/RQuantLib/src/zero.cpp
Log:
more new API conversion
move coupon.cpp and cbond.cpp to src/unused for now
white-space only changes in the R files
Modified: pkg/RQuantLib/R/bond.R
===================================================================
--- pkg/RQuantLib/R/bond.R 2010-06-17 02:45:45 UTC (rev 256)
+++ pkg/RQuantLib/R/bond.R 2010-06-17 11:49:51 UTC (rev 257)
@@ -32,26 +32,25 @@
settlementDays=1,
calendar='us',
businessDayConvention='Following')) {
- val <- 0
+ 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='us'}
- if (is.null(dateparams$businessDayConvention)) {dateparams$businessDayConvention='Following'}
+ if (is.null(dateparams$businessDayConvention)) {dateparams$businessDayConvention='Following'}
if (is.null(dateparams$refDate)) {dateparams$refDate=bond$issueDate}
dateparams <- matchParams(dateparams)
-
+
val <- .Call("QL_ZeroBondWithRebuiltCurve",
- bond, c(discountCurve$table$date),
+ bond, c(discountCurve$table$date),
discountCurve$table$zeroRates, dateparams,
PACKAGE="RQuantLib")
-
val$cashFlow <- as.data.frame(val$cashFlow)
- class(val) <- c("ZeroCouponBond", "Bond")
+ class(val) <- c("ZeroCouponBond", "Bond")
val
}
@@ -119,7 +118,7 @@
rates,
discountCurve,
dateparams=list(
-
+
settlementDays=1,
calendar='us',
businessDayConvention='Following',
@@ -136,7 +135,7 @@
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='us'}
if (is.null(dateparams$businessDayConvention)){
@@ -147,19 +146,19 @@
}
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$dateGeneration)){dateparams$dateGeneration='Backward'}
+ if (is.null(dateparams$endOfMonth)){dateparams$endOfMonth=0}
if (is.null(dateparams$fixingDays)){dateparams$fixingDays=2}
-
+
dateparams <- matchParams(dateparams)
-
+
val <- .Call("QL_FixedRateWithRebuiltCurve",
- bond, rates, c(discountCurve$table$date),
+ bond, rates, c(discountCurve$table$date),
discountCurve$table$zeroRates, dateparams,
- PACKAGE="RQuantLib")
+ PACKAGE="RQuantLib")
val$cashFlow <- as.data.frame(val$cashFlow)
- class(val) <- c("FixedRateBond", "Bond")
+ class(val) <- c("FixedRateBond", "Bond")
val
}
@@ -259,8 +258,8 @@
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='us'}
if (is.null(dateparams$businessDayConvention)){
@@ -271,25 +270,25 @@
}
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$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,
+
+ indexparams <- list(type=index$type, length=index$length,
inTermOf=index$inTermOf)
ibor <- index$term
val <- .Call("QL_FloatingWithRebuiltCurve",
bond, gearings, spreads, caps, floors, indexparams,
c(ibor$table$date), ibor$table$zeroRates,
- c(curve$table$date), curve$table$zeroRates,
- dateparams,
+ c(curve$table$date), curve$table$zeroRates,
+ dateparams,
PACKAGE="RQuantLib")
-
+
val$cashFlow <- as.data.frame(val$cashFlow)
- class(val) <- c("FloatingRateBond", "Bond")
+ class(val) <- c("FloatingRateBond", "Bond")
val
}
@@ -324,32 +323,32 @@
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='us'}
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 <- .Call("QL_ConvertibleZeroBond",
+ dividendYield <- process$divYield
+ riskFreeRate <- process$rff
+ val <- .Call("QL_ConvertibleZeroBond",
bondparams, process,
- c(dividendYield$table$date),
+ c(dividendYield$table$date),
dividendYield$table$zeroRates,
- c(riskFreeRate$table$date),
+ c(riskFreeRate$table$date),
riskFreeRate$table$zeroRates,
dividendSchedule, callabilitySchedule, dateparams,
PACKAGE="RQuantLib")
val$cashFlow <- as.data.frame(val$cashFlow)
- class(val) <- c("ConvertibleZeroCouponBond", "Bond")
+ class(val) <- c("ConvertibleZeroCouponBond", "Bond")
val
}
@@ -369,7 +368,7 @@
businessDayConvention='Following'
)
){
-
+
val <- 0
if (is.null(bondparams$exercise)){bondparams$exercise='am'}
@@ -383,32 +382,32 @@
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='us'}
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 <- .Call("QL_ConvertibleFixedBond",
+ dividendYield <- process$divYield
+ riskFreeRate <- process$rff
+ val <- .Call("QL_ConvertibleFixedBond",
bondparams, coupon, process,
- c(dividendYield$table$date),
+ c(dividendYield$table$date),
dividendYield$table$zeroRates,
- c(riskFreeRate$table$date),
+ c(riskFreeRate$table$date),
riskFreeRate$table$zeroRates,
dividendSchedule, callabilitySchedule, dateparams,
PACKAGE="RQuantLib")
val$cashFlow <- as.data.frame(val$cashFlow)
- class(val) <- c("ConvertibleFixedCouponBond", "Bond")
+ class(val) <- c("ConvertibleFixedCouponBond", "Bond")
val
}
@@ -428,7 +427,7 @@
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}
@@ -440,41 +439,41 @@
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='us'}
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
+ dividendYield <- process$divYield
+ riskFreeRate <- process$rff
- indexparams <- list(type=iborindex$type, length=iborindex$length,
+ indexparams <- list(type=iborindex$type, length=iborindex$length,
inTermOf=iborindex$inTermOf)
ibor <- iborindex$term
- val <- .Call("QL_ConvertibleFloatingBond",
+ val <- .Call("QL_ConvertibleFloatingBond",
bondparams, process,
- c(dividendYield$table$date),
+ c(dividendYield$table$date),
dividendYield$table$zeroRates,
- c(riskFreeRate$table$date),
+ c(riskFreeRate$table$date),
riskFreeRate$table$zeroRates,
- c(ibor$table$date),
+ c(ibor$table$date),
ibor$table$zeroRates,
indexparams,spread,
dividendSchedule, callabilitySchedule, dateparams,
PACKAGE="RQuantLib")
val$cashFlow <- as.data.frame(val$cashFlow)
- class(val) <- c("ConvertibleFloatingCouponBond", "Bond")
+ class(val) <- c("ConvertibleFloatingCouponBond", "Bond")
val
}
@@ -499,8 +498,8 @@
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='us'}
if (is.null(dateparams$businessDayConvention)){
@@ -515,15 +514,15 @@
dateparams <- matchParams(dateparams)
callSch <- bondparams$callSch
# hw.termStructure <- hullWhite$term
-
+
val <- .Call("QL_CallableBond", bondparams, hullWhite,coupon,
# c(hw.termStructure$table$date),
# hw.termStructure$table$zeroRates,
callSch, dateparams,
PACKAGE="RQuantLib")
val$cashFlow <- as.data.frame(val$cashFlow)
- class(val) <- c("CallableBond", "Bond")
- val
+ class(val) <- c("CallableBond", "Bond")
+ val
}
FittedBondCurve <- function(curveparams,
@@ -563,7 +562,7 @@
# atmSwapTenors <- swaptionVol$atmSwapTenors
# volMatrix <- swaptionVol$volatilityMatrix
# swapIndex <- matchParams(swapIndex)
-# ibor <- iborIndex$term
+# ibor <- iborIndex$term
# val <- .Call("QL_CMSBond", bondparams, iborIndex, swapIndex, cap, floor, gearings, spreads,
# swaptionVol, atmOptionTenors, atmSwapTenors, volMatrix, pricer
# ibor$table$dates, ibor$table$zeroRates)
@@ -575,7 +574,7 @@
"Business252", "OneDayCounter", "SimpleDayCounter", "Thirty360"))
{
if (!is.numeric(daycounter)) {
- daycounter <- match.arg(daycounter)
+ daycounter <- match.arg(daycounter)
daycounter <- switch(daycounter,
Actual360 = 0,
ActualFixed = 1,
@@ -585,7 +584,7 @@
SimpleDayCounter = 5,
Thirty360 = 6)
}
- daycounter
+ daycounter
}
matchBDC <- function(bdc = c("Following", "ModifiedFollowing",
@@ -593,26 +592,26 @@
"Unadjusted")) {
if (!is.numeric(bdc)){
bdc <- match.arg(bdc)
- bdc <- switch(bdc,
+ bdc <- switch(bdc,
Following = 0,
ModifiedFollowing = 1,
Preceding = 2,
ModifiedPreceding = 3,
Unadjusted = 4)
}
- bdc
+ bdc
}
-matchCompounding <- function(cp = c("Simple", "Compounded",
+matchCompounding <- function(cp = c("Simple", "Compounded",
"Continuous", "SimpleThenCompounded")) {
if (!is.numeric(cp)){
cp <- match.arg(cp)
cp <- switch(cp,
- Simple = 0,
+ Simple = 0,
Compounded = 1,
Continuous = 2,
SimpleThenCompounded = 3)
- }
+ }
cp
}
matchFrequency <- function(freq = c("NoFrequency","Once", "Annual",
@@ -622,7 +621,7 @@
"Weekly", "Daily")){
if (!is.numeric(freq)){
freq <- match.arg(freq)
- freq <- switch(freq,
+ freq <- switch(freq,
NoFrequency = -1, Once = 0, Annual = 1,
Semiannual = 2, EveryFourthMonth = 3,
Quarterly = 4, Bimonthly = 6,
@@ -632,7 +631,7 @@
freq
}
matchDateGen <- function(dg = c("Backward", "Forward", "Zero",
- "ThirdWednesday", "Twentieth",
+ "ThirdWednesday", "Twentieth",
"TwentiethIMM")){
if (!is.numeric(dg)){
dg <- match.arg(dg)
@@ -646,7 +645,7 @@
matchParams <- function(params) {
-
+
if (!is.null(params$dayCounter)) {
params$dayCounter <- matchDayCounter(params$dayCounter)
}
Modified: pkg/RQuantLib/R/discount.R
===================================================================
--- pkg/RQuantLib/R/discount.R 2010-06-17 02:45:45 UTC (rev 256)
+++ pkg/RQuantLib/R/discount.R 2010-06-17 11:49:51 UTC (rev 257)
@@ -1,6 +1,8 @@
## RQuantLib function DiscountCurve
##
-## Copyright (C) 2005 Dominick Samperi
+## Copyright (C) 2005 Dominick Samperi
+## Copyright (C) 2007 - 2009 Dirk Eddelbuettel
+## Copyright (C) 2009 - 2010 Dirk Eddelbuettel and Khanh Nguyen
##
## $Id: discount.R,v 1.3 2007/12/31 02:11:19 edd Exp $
##
@@ -14,87 +16,77 @@
## PURPOSE. See the GNU General Public License for more
## details.
-
-
DiscountCurve <- function(params, tsQuotes, times=seq(0,10,.1)) {
- UseMethod("DiscountCurve")
+ UseMethod("DiscountCurve")
}
DiscountCurve.default <- function(params, tsQuotes, times=seq(0,10,.1)) {
- # Check that params is properly formatted.
- if(!is.list(params) || length(params) == 0) {
- stop("The params parameter must be a non-empty list");
- }
+ ## Check that params is properly formatted.
+ if(!is.list(params) || length(params) == 0) {
+ stop("The params parameter must be a non-empty list");
+ }
- # 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")
- }
- if(length(tsQuotes) != length(names(tsQuotes))) {
- stop("Term structure quotes must include labels")
- }
- if(!is.numeric(unlist(tsQuotes))) {
- stop("Term structure quotes must have numeric values")
- }
+ ## 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")
+ }
+ if(length(tsQuotes) != length(names(tsQuotes))) {
+ stop("Term structure quotes must include labels")
+ }
+ if(!is.numeric(unlist(tsQuotes))) {
+ stop("Term structure quotes must have numeric values")
+ }
- # Check the times vector
- if(!is.numeric(times) || length(times) == 0)
- stop("The times parameter must be a non-emptry numeric vector")
+ ## Check the times vector
+ if(!is.numeric(times) || length(times) == 0) {
+ stop("The times parameter must be a non-emptry numeric vector")
+ }
- # Finally ready to make the call...
- val <- .Call("QL_DiscountCurve", params, tsQuotes, times,
- PACKAGE="RQuantLib")
- class(val) <- c("DiscountCurve")
- val$table <- as.data.frame(val$table)
- val
+ ## Finally ready to make the call...
+ val <- .Call("QL_DiscountCurve", params, tsQuotes, times, PACKAGE="RQuantLib")
+ 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.DiscountCurve <- function(x, setpar=TRUE, dolegend=TRUE,...) {
+ if(setpar) {
+ savepar <- par(mfrow=c(3,1))
}
- 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')
+ 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')
+ }
}
- }
- else {
- plot(x$times, x$forwards, type='l',
- main='forwards',xlab='time',ylab='fwd rate')
+ plot(x$times, x$discounts, type='l',
+ main='discounts',xlab='time',ylab='discount')
if(dolegend) {
- legend('center','center',paste(x$params$interpHow, 'discount'),bty='n',
- text.col='red')
+ 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')
+ }
}
- 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')
+ if (setpar) {
+ par(savepar)
}
- }
- 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)
- }
}
Deleted: pkg/RQuantLib/src/MFcoupon.cpp
===================================================================
--- pkg/RQuantLib/src/MFcoupon.cpp 2010-06-17 02:45:45 UTC (rev 256)
+++ pkg/RQuantLib/src/MFcoupon.cpp 2010-06-17 11:49:51 UTC (rev 257)
@@ -1,117 +0,0 @@
-#include "rquantlib.hpp"
-
-
-RcppExport SEXP cfamounts(SEXP params){
-
- SEXP rl=R_NilValue;
- char* exceptionMesg=NULL;
- try{
- RcppParams rparam(params);
-
- QuantLib::Date maturity(dateFromR(rparam.getDateValue("Maturity")));
- QuantLib::Date settle(dateFromR(rparam.getDateValue("Settle")));
- QuantLib::Date issue(dateFromR(rparam.getDateValue("IssueDate")));
-
- double rate = rparam.getDoubleValue("CouponRate");
- std::vector<double> rateVec(1, rate);
- double faceAmount = rparam.getDoubleValue("Face");
- double period = rparam.getDoubleValue("Period");
- double basis = rparam.getDoubleValue("Basis");
- DayCounter dayCounter = getDayCounter(basis);
- Frequency freq = getFrequency(period);
- Period p(freq);
- double EMR = rparam.getDoubleValue("EMR");
- Calendar calendar=UnitedStates(UnitedStates::GovernmentBond);
-
-
- Schedule sch(settle, maturity, p, calendar,
- Unadjusted, Unadjusted, DateGeneration::Backward,
- (EMR == 1)? true : false);
-
- FixedRateBond bond(1, faceAmount, sch, rateVec, dayCounter, Following,
- 100, issue);
-
- //cashflow
- int numCol = 2;
- std::vector<std::string> colNames(numCol);
- colNames[0] = "Date";
- colNames[1] = "Amount";
- RcppFrame frame(colNames);
-
- Leg bondCashFlow = bond.cashflows();
- for (unsigned int i = 0; i< bondCashFlow.size(); i++){
- std::vector<ColDatum> row(numCol);
- Date d = bondCashFlow[i]->date();
- row[0].setDateValue(RcppDate(d.month(), d.dayOfMonth(), d.year()));
- row[1].setDoubleValue(bondCashFlow[i]->amount());
- frame.addRow(row);
- }
-
- RcppResultSet rs;
- rs.add("cashFlow", frame);
- rl = rs.getReturnList();
-
- } catch(std::exception& ex) {
- exceptionMesg = copyMessageToR(ex.what());
- } catch(...) {
- exceptionMesg = copyMessageToR("unknown reason");
- }
- if(exceptionMesg != NULL)
- Rf_error(exceptionMesg);
- return rl;
-}
-
-
-RcppExport SEXP cfdates(SEXP params){
- SEXP rl = R_NilValue;
- char* exceptionMesg = NULL;
- try {
- RcppParams rparam(params);
-
- double basis = rparam.getDoubleValue("dayCounter");
- DayCounter dayCounter = getDayCounter(basis);
- double p = rparam.getDoubleValue("period");
- Frequency freq = getFrequency(p);
- Period period(freq);
- double emr = rparam.getDoubleValue("emr");
-
- bool endOfMonth = false;
- if (emr == 1) endOfMonth = true;
-
- QuantLib::Date d1(dateFromR(rparam.getDateValue("settle")));
- QuantLib::Date d2(dateFromR(rparam.getDateValue("maturity")));
- Calendar calendar=UnitedStates(UnitedStates::GovernmentBond);
-
- Schedule sch(d1, d2, period, calendar, Unadjusted,
- Unadjusted, DateGeneration::Backward, endOfMonth);
-
- //cfdates
- int numCol = 1;
- std::vector<std::string> colNames(numCol);
- colNames[0] = "Date";
- RcppFrame frame(colNames);
-
- std::vector<QuantLib::Date> dates = sch.dates();
- for (unsigned int i = 0; i< dates.size(); i++){
- std::vector<ColDatum> row(numCol);
- Date d = dates[i];
- row[0].setDateValue(RcppDate(d.month(), d.dayOfMonth(), d.year()));
- frame.addRow(row);
- }
- RcppResultSet rs;
- rs.add("", frame);
- rl = rs.getReturnList();
- }
- catch(std::exception& ex) {
- exceptionMesg = copyMessageToR(ex.what());
- } catch(...) {
- exceptionMesg = copyMessageToR("unknown reason");
- }
- if(exceptionMesg != NULL)
- Rf_error(exceptionMesg);
-
- return rl;
-}
-
-
-
Modified: pkg/RQuantLib/src/curves.cpp
===================================================================
--- pkg/RQuantLib/src/curves.cpp 2010-06-17 02:45:45 UTC (rev 256)
+++ pkg/RQuantLib/src/curves.cpp 2010-06-17 11:49:51 UTC (rev 257)
@@ -2,8 +2,8 @@
//
// RQuantLib helper functions for term structure construction
//
-// Copyright (C) 2005 - 2007 Dominick Samperi
-// Copyright (C) 2007 - 2009 Dirk Eddelbuettel <edd at debian.org>
+// Copyright (C) 2005 - 2007 Dominick Samperi
+// Copyright (C) 2007 - 2010 Dirk Eddelbuettel
//
// $Id$
//
@@ -17,11 +17,11 @@
// PURPOSE. See the GNU General Public License for more
// details.
-#ifndef _MSC_VER
-#include <stdexcept>
-#endif
+//#ifndef _MSC_VER
+//#include <stdexcept>
+//#endif
-#include "rquantlib.hpp"
+#include <rquantlib.hpp>
// Database of interest rate instrument contract details.
ObservableDB::ObservableDB() {
Modified: pkg/RQuantLib/src/discount.cpp
===================================================================
--- pkg/RQuantLib/src/discount.cpp 2010-06-17 02:45:45 UTC (rev 256)
+++ pkg/RQuantLib/src/discount.cpp 2010-06-17 11:49:51 UTC (rev 257)
@@ -2,8 +2,9 @@
//
// RQuantLib function DiscountCurve
//
-// Copyright (C) 2005 - 2007 Dominick Samperi
-// Copyright (C) 2007 - 2009 Dirk Eddelbuettel <edd at debian.org>
+// Copyright (C) 2005 - 2007 Dominick Samperi
+// Copyright (C) 2007 - 2009 Dirk Eddelbuettel
+// Copyright (C) 2009 - 2010 Dirk Eddelbuettel and Khanh Nguyen
//
// $Id$
//
@@ -20,33 +21,32 @@
#include "rquantlib.hpp"
RcppExport SEXP QL_DiscountCurve(SEXP params, SEXP tsQuotes, SEXP times) {
- SEXP rl = R_NilValue;
- char* exceptionMesg = NULL;
try {
- // Parameter wrapper classes.
- RcppParams rparam(params);
- RcppNumList tslist(tsQuotes);
+ Rcpp::List rparam(params); // parameter in list
+ Rcpp::List tslist(tsQuotes);
+ std::vector<std::string> tsNames = tslist.names();
+ Rcpp::NumericVector tvec(times);
int i;
- Date todaysDate( dateFromR(rparam.getDateValue("tradeDate") ));
- Date settlementDate( dateFromR(rparam.getDateValue("settleDate") ));
+ Date todaysDate( dateFromR( Rcpp::as<int>(rparam["tradeDate"]) ));
+ Date settlementDate( dateFromR( Rcpp::as<int>(rparam["settleDate"]) ));
//std::cout << "TradeDate: " << todaysDate << std::endl << "Settle: " << settlementDate << std::endl;
RQLContext::instance().settleDate = settlementDate;
Settings::instance().evaluationDate() = todaysDate;
- std::string firstQuoteName = tslist.getName(0);
+ std::string firstQuoteName = tsNames[0];
- double dt = rparam.getDoubleValue("dt");
+ double dt = Rcpp::as<double>(rparam["dt"]);
std::string interpWhat, interpHow;
bool flatQuotes = true;
if (firstQuoteName.compare("flat") != 0) {
// Get interpolation method (not needed for "flat" case)
- interpWhat = rparam.getStringValue("interpWhat");
- interpHow = rparam.getStringValue("interpHow");
+ interpWhat = Rcpp::as<std::string>(rparam["interpWhat"]);
+ interpHow = Rcpp::as<std::string>(rparam["interpHow"]);
flatQuotes = false;
}
@@ -61,9 +61,9 @@
double tolerance = 1.0e-8;
boost::shared_ptr<YieldTermStructure> curve;
- if (firstQuoteName.compare("flat") == 0) {
- // Create a flat term structure.
- double rateQuote = tslist.getValue(0);
+
+ if (firstQuoteName.compare("flat") == 0) { // Create a flat term structure.
+ double rateQuote = Rcpp::as<double>(tslist[0]);
//boost::shared_ptr<Quote> flatRate(new SimpleQuote(rateQuote));
//boost::shared_ptr<FlatForward> ts(new FlatForward(settlementDate,
// Handle<Quote>(flatRate),
@@ -71,12 +71,11 @@
boost::shared_ptr<SimpleQuote> rRate(new SimpleQuote(rateQuote));
curve = flatRate(settlementDate,rRate,ActualActual());
- } else {
- // Build curve based on a set of observed rates and/or prices.
+ } else { // Build curve based on a set of observed rates and/or prices.
std::vector<boost::shared_ptr<RateHelper> > curveInput;
for(i = 0; i < tslist.size(); i++) {
- std::string name = tslist.getName(i);
- double val = tslist.getValue(i);
+ std::string name = tsNames[i];
+ double val = Rcpp::as<double>(tslist[i]);
boost::shared_ptr<RateHelper> rh = ObservableDB::instance().getRateHelper(name, val);
// edd 2009-11-01 FIXME NULL_RateHelper no longer builds under 0.9.9
// if (rh == NULL_RateHelper)
@@ -90,60 +89,76 @@
}
// Return discount, forward rate, and zero coupon curves
- int numCol = 2;
- std::vector<std::string> colNames(numCol);
- colNames[0] = "date";
- colNames[1] = "zeroRates";
+ //int numCol = 2;
+ //std::vector<std::string> colNames(numCol);
+ //colNames[0] = "date";
+ //colNames[1] = "zeroRates";
+ //RcppFrame frame(colNames);
- RcppFrame frame(colNames);
+ int ntimes = tvec.size(); //Rf_length(times);
+ //SEXP disc = PROTECT(Rf_allocVector(REALSXP, ntimes));
+ //SEXP fwds = PROTECT(Rf_allocVector(REALSXP, ntimes));
+ //SEXP zero = PROTECT(Rf_allocVector(REALSXP, ntimes));
+ Rcpp::NumericVector disc(ntimes), fwds(ntimes), zero(ntimes);
- int ntimes = Rf_length(times);
- SEXP disc = PROTECT(Rf_allocVector(REALSXP, ntimes));
- SEXP fwds = PROTECT(Rf_allocVector(REALSXP, ntimes));
- SEXP zero = PROTECT(Rf_allocVector(REALSXP, ntimes));
-
-
Date current = settlementDate;
- double t;
- for(i = 0; i < ntimes; i++) {
- t = REAL(times)[i];
- REAL(disc)[i] = curve->discount(t);
- REAL(fwds)[i] = curve->forwardRate(t, t+dt, Continuous);
- REAL(zero)[i] = curve->zeroRate(t, Continuous);
+ for (i = 0; i < ntimes; i++) {
+ //t = REAL(times)[i];
+ //REAL(disc)[i] = curve->discount(t);
+ //REAL(fwds)[i] = curve->forwardRate(t, t+dt, Continuous);
+ //REAL(zero)[i] = curve->zeroRate(t, Continuous);
+ double t = tvec[i];
+ disc[i] = curve->discount(t);
+ fwds[i] = curve->forwardRate(t, t+dt, Continuous);
+ zero[i] = curve->zeroRate(t, Continuous);
}
+ int n = curve->maxDate() - settlementDate;
+ //std::cout << "MaxDate " << curve->maxDate() << std::endl;
+ //std::cout << "Settle " << settlementDate << std::endl;
+ //n = std::min(300, n);
- int n = curve->maxDate() - settlementDate;
- for (int i = 0; i<n;i++){
- std::vector<ColDatum> row(numCol);
- Date d = current;
- row[0].setDateValue(RcppDate(d.month(), d.dayOfMonth(), d.year()));
-
+ RcppDateVector dates(n);
+ Rcpp::NumericVector zeroRates(n);
+ Date d = current;
+ for (int i = 0; i<n && d < curve->maxDate(); i++){
+ //std::vector<ColDatum> row(numCol);
+ //row[0].setDateValue(RcppDate(d.month(), d.dayOfMonth(), d.year()));
+ dates(i) = RcppDate(d.month(), d.dayOfMonth(), d.year());
double zrate = curve->zeroRate(current, ActualActual(), Continuous);
- row[1].setDoubleValue(zrate);
- frame.addRow(row);
- current++;
+ zeroRates[i] = zrate;
+ //row[1].setDoubleValue(zrate);
+ //frame.addRow(row);
+ d++;
}
- RcppResultSet rs;
- rs.add("times", times, false);
- rs.add("discounts", disc, true);
- rs.add("forwards", fwds, true);
- rs.add("zerorates", zero, true);
- rs.add("flatQuotes", flatQuotes);
- rs.add("params", params, false);
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/rquantlib -r 257
More information about the Rquantlib-commits
mailing list