[Rquantlib-commits] r294 - in pkg/RQuantLib: . R inst man src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Aug 7 19:13:28 CEST 2010
Author: edd
Date: 2010-08-07 19:13:28 +0200 (Sat, 07 Aug 2010)
New Revision: 294
Modified:
pkg/RQuantLib/NAMESPACE
pkg/RQuantLib/R/arrays.R
pkg/RQuantLib/inst/ChangeLog
pkg/RQuantLib/man/EuropeanOptionArrays.Rd
pkg/RQuantLib/src/vanilla.cpp
Log:
rewritten EuropeanOptionArrays with vectorisation at the C++ level
Modified: pkg/RQuantLib/NAMESPACE
===================================================================
--- pkg/RQuantLib/NAMESPACE 2010-08-07 15:56:13 UTC (rev 293)
+++ pkg/RQuantLib/NAMESPACE 2010-08-07 17:13:28 UTC (rev 294)
@@ -5,6 +5,7 @@
export(
##--arrays.R
+ "oldEuropeanOptionArrays",
"EuropeanOptionArrays",
##--asian.R
"AsianOption",
Modified: pkg/RQuantLib/R/arrays.R
===================================================================
--- pkg/RQuantLib/R/arrays.R 2010-08-07 15:56:13 UTC (rev 293)
+++ pkg/RQuantLib/R/arrays.R 2010-08-07 17:13:28 UTC (rev 294)
@@ -1,6 +1,6 @@
## RQuantLib -- R interface to the QuantLib libraries
##
-## Copyright (C) 2002 - 2009 Dirk Eddelbuettel <edd at debian.org>
+## Copyright (C) 2002 - 2010 Dirk Eddelbuettel <edd at debian.org>
##
## $Id: arrays.R,v 1.2 2002/11/15 01:49:28 edd Exp $
##
@@ -20,8 +20,8 @@
## Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
## MA 02111-1307, USA
-EuropeanOptionArrays <- function(type, underlying, strike, dividendYield,
- riskFreeRate, maturity, volatility) {
+oldEuropeanOptionArrays <- function(type, underlying, strike, dividendYield,
+ riskFreeRate, maturity, volatility) {
n.underlying <- length(underlying)
n.strike <- length(strike)
n.dividendYield <- length(dividendYield)
@@ -78,8 +78,9 @@
volatility=volatility)))
}
-newEuropeanOptionArrays <- function(type, underlying, strike, dividendYield,
- riskFreeRate, maturity, 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,
@@ -91,16 +92,19 @@
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 <- .Call("EuropeanOptionArray", type, pars, PACKAGE="RQuantLib")
+ val <- .Call("EuropeanOptionArrays", type, as.matrix(pars), PACKAGE="RQuantLib")
-
+ ## 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)))
}
-
-
-
-
Modified: pkg/RQuantLib/inst/ChangeLog
===================================================================
--- pkg/RQuantLib/inst/ChangeLog 2010-08-07 15:56:13 UTC (rev 293)
+++ pkg/RQuantLib/inst/ChangeLog 2010-08-07 17:13:28 UTC (rev 294)
@@ -1,5 +1,12 @@
-2010-08-07 Dirk Eddelbuettel <edd at dexter>
+2010-08-07 Dirk Eddelbuettel <edd at debian.org>
+ * R/arrays.R: Rewrote EuropeanOptionArrays() to have vectorisation on
+ the C++ side rather than in R; external interface unchanged and the
+ old implementation is still available just in case
+ * src/vanilla.cpp: New function EuropeanOptionArrays() looping over a
+ grid defined by vectors of any two of the six possible numeric inputs
+ * man/EuropeanOptionArrays.Rd: Updated accordingly
+
* src/*cpp: Drop QL_ prefix from functions called from R
* R/*: Drop QL_ prefix in functions called by .Call()
Modified: pkg/RQuantLib/man/EuropeanOptionArrays.Rd
===================================================================
--- pkg/RQuantLib/man/EuropeanOptionArrays.Rd 2010-08-07 15:56:13 UTC (rev 293)
+++ pkg/RQuantLib/man/EuropeanOptionArrays.Rd 2010-08-07 17:13:28 UTC (rev 294)
@@ -1,6 +1,7 @@
% $Id: EuropeanOptionArrays.Rd,v 1.4 2004/12/28 03:20:07 edd Exp $
\name{EuropeanOptionArrays}
\alias{EuropeanOptionArrays}
+\alias{oldEuropeanOptionArrays}
\title{European Option evaluation using Closed-Form solution}
\description{
The \code{EuropeanOptionArrays} function allows any of the numerical
@@ -11,6 +12,7 @@
}
\usage{
EuropeanOptionArrays(type, underlying, strike, dividendYield, riskFreeRate, maturity, volatility)
+oldEuropeanOptionArrays(type, underlying, strike, dividendYield, riskFreeRate, maturity, volatility)
}
\arguments{
\item{type}{A string with one of the values \code{call} or \code{put}}
@@ -22,20 +24,25 @@
\item{volatility}{(Scalar or list) volatilit(y|ies) of the underlying stock}
}
\value{
- The \code{EuropeanOptionArrays} function allows each of the numerical
- input parameters to be a list (or vector, or sequence). A list of
- multi-dimensional arrays is returned. Each array point corresponds to
+ The \code{EuropeanOptionArrays} function allows any two of the numerical
+ input parameters to be a vector or sequence. A list of
+ two-dimensional matrices is returned. Each cell corresponds to
an evaluation under the given set of parameters.
For these functions, the following components are returned:
- \item{value}{(Scalar or array) value of option}
- \item{delta}{(Scalar or array) change in value for a change in the underlying}
- \item{gamma}{(Scalar or array) change in value for a change in delta}
- \item{vega}{(Scalar or array) change in value for a change in the underlying's volatility}
- \item{theta}{(Scalar or array) change in value for a change in delta}
- \item{rho}{(Scalar or array) change in value for a change in time to maturity}
- \item{dividendRho}{(Scalar or array) change in value for a change in delta}
+ \item{value}{(matrix) value of option}
+ \item{delta}{(matrix) change in value for a change in the underlying}
+ \item{gamma}{(matrix) change in value for a change in delta}
+ \item{vega}{(matrix) change in value for a change in the underlying's volatility}
+ \item{theta}{(matrix) change in value for a change in delta}
+ \item{rho}{(matrix) change in value for a change in time to maturity
+ \item{dividendRho}{(matrix) change in value for a change in delta}
\item{parameters}{List with parameters with which object was created}
+
+ The \code{oldEuropeanOptionArrays} function is an older implementation
+ which vectorises this at the R level instead but allows more general
+ multidimensional arrays.
+
}
\details{
The well-known closed-form solution derived by Black, Scholes and
Modified: pkg/RQuantLib/src/vanilla.cpp
===================================================================
--- pkg/RQuantLib/src/vanilla.cpp 2010-08-07 15:56:13 UTC (rev 293)
+++ pkg/RQuantLib/src/vanilla.cpp 2010-08-07 17:13:28 UTC (rev 294)
@@ -143,3 +143,66 @@
return R_NilValue;
}
+RcppExport SEXP EuropeanOptionArrays(SEXP typesexp, SEXP parsexp) {
+
+ try {
+ Option::Type optionType = getOptionType( Rcpp::as<std::string>(typesexp) );
+ Rcpp::NumericMatrix par(parsexp); // matrix of parameters as per expand.grid() in R
+ int n = par.nrow();
+ Rcpp::NumericVector value(n), delta(n), gamma(n), vega(n), theta(n), rho(n), divrho(n);
+
+ Date today = Date::todaysDate();
+ Settings::instance().evaluationDate() = today;
+
+ DayCounter dc = Actual360();
+
+ for (int i=0; i<n; i++) {
+
+ // pars <- expand.grid(underlying, strike, dividendYield, riskFreeRate, maturity, volatility)
+
+ double underlying = par(i, 0); // first column
+ double strike = par(i, 1); // second column
+ Spread dividendYield = par(i, 2); // third column
+ Rate riskFreeRate = par(i, 3); // fourth column
+ Time maturity = par(i, 4); // fifth column
+ int length = int(maturity*360 + 0.5); // FIXME: this could be better
+ double volatility = par(i, 5); // sixth column
+
+ boost::shared_ptr<SimpleQuote> spot(new SimpleQuote( underlying ));
+ boost::shared_ptr<SimpleQuote> vol(new SimpleQuote( volatility ));
+ boost::shared_ptr<BlackVolTermStructure> volTS = flatVol(today, vol, dc);
+ boost::shared_ptr<SimpleQuote> qRate(new SimpleQuote( dividendYield ));
+ boost::shared_ptr<YieldTermStructure> qTS = flatRate(today, qRate, dc);
+ boost::shared_ptr<SimpleQuote> rRate(new SimpleQuote( riskFreeRate ));
+ boost::shared_ptr<YieldTermStructure> rTS = flatRate(today, rRate, dc);
+
+ Date exDate = today + length;
+ boost::shared_ptr<Exercise> exercise(new EuropeanExercise(exDate));
+
+ boost::shared_ptr<StrikedTypePayoff> payoff(new PlainVanillaPayoff(optionType, strike));
+ boost::shared_ptr<VanillaOption> option = makeOption(payoff, exercise, spot, qTS, rTS, volTS);
+
+ value[i] = option->NPV();
+ delta[i] = option->delta();
+ gamma[i] = option->gamma();
+ vega[i] = option->vega();
+ theta[i] = option->theta();
+ rho[i] = option->rho();
+ divrho[i] = option->dividendRho();
+ }
+ return Rcpp::List::create(Rcpp::Named("value") = value,
+ Rcpp::Named("delta") = delta,
+ Rcpp::Named("gamma") = gamma,
+ Rcpp::Named("vega") = vega,
+ Rcpp::Named("theta") = theta,
+ Rcpp::Named("rho") = rho,
+ Rcpp::Named("divRho") = divrho);
+
+ } catch(std::exception &ex) {
+ forward_exception_to_r(ex);
+ } catch(...) {
+ ::Rf_error("c++ exception (unknown reason)");
+ }
+
+ return R_NilValue;
+}
More information about the Rquantlib-commits
mailing list