[Rquantlib-commits] r296 - in pkg/RQuantLib: . R inst man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Aug 7 20:42:14 CEST 2010


Author: edd
Date: 2010-08-07 20:42:14 +0200 (Sat, 07 Aug 2010)
New Revision: 296

Modified:
   pkg/RQuantLib/DESCRIPTION
   pkg/RQuantLib/NAMESPACE
   pkg/RQuantLib/R/arrays.R
   pkg/RQuantLib/inst/ChangeLog
   pkg/RQuantLib/man/EuropeanOptionArrays.Rd
Log:
factored plotOptionSurface() out of demo()


Modified: pkg/RQuantLib/DESCRIPTION
===================================================================
--- pkg/RQuantLib/DESCRIPTION	2010-08-07 17:21:41 UTC (rev 295)
+++ pkg/RQuantLib/DESCRIPTION	2010-08-07 18:42:14 UTC (rev 296)
@@ -25,6 +25,7 @@
  QuantLib itself is released under a somewhat less restrictive Open Source
  license (see QuantLib-License.txt).
 Depends: R (>= 2.10.0), Rcpp (>= 0.8.4)
+Suggests: rgl
 LinkingTo: Rcpp
 SystemRequirements: QuantLib library (>= 0.9.9) from http://quantlib.org, 
  Boost library from http://www.boost.org

Modified: pkg/RQuantLib/NAMESPACE
===================================================================
--- pkg/RQuantLib/NAMESPACE	2010-08-07 17:21:41 UTC (rev 295)
+++ pkg/RQuantLib/NAMESPACE	2010-08-07 18:42:14 UTC (rev 296)
@@ -7,6 +7,7 @@
        ##--arrays.R
        "oldEuropeanOptionArrays",
        "EuropeanOptionArrays",
+       "plotOptionSurface",
        ##--asian.R
        "AsianOption",
        ##--bermudan.R

Modified: pkg/RQuantLib/R/arrays.R
===================================================================
--- pkg/RQuantLib/R/arrays.R	2010-08-07 17:21:41 UTC (rev 295)
+++ pkg/RQuantLib/R/arrays.R	2010-08-07 18:42:14 UTC (rev 296)
@@ -107,4 +107,56 @@
     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) {
+    stopifnot(require(rgl))
+    axis.col <- "black"
+    text.col <- axis.col
+    ylab <- ylabel
+    xlab <- xlabel
+    zlab <- zlabel
+    y <- EOres
+
+    ## clear scene:
+    clear3d()
+    clear3d(type="bbox")
+    clear3d(type="lights")
+
+    ## setup env:
+    bg3d(color="#DDDDDD")
+    light3d()
+
+    rgl.viewpoint(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))
+    rgl.surface(x, z, y, alpha=0.6, lit=TRUE, color="blue")
+    rgl.lines(c(0,1), c(0,0), c(0,0), col=axis.col)
+    rgl.lines(c(0,0), c(0,1), c(0,0), col=axis.col)
+    rgl.lines(c(0,0),c(0,0), c(0,1), col=axis.col)
+    rgl.texts(1,0,0, xlab, adj=1, col=text.col)
+    rgl.texts(0,1,0, ylab, adj=1, col=text.col)
+    rgl.texts(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))
+    rgl.surface(x[xgridind], z[zgridind], y[xgridind,zgridind],
+                color="darkgray", alpha=0.5, lit=TRUE,
+                front="lines", back="lines")
+
+    ## animate (credit to rgl.viewpoint() example)
+    start <- proc.time()[3]
+    while ((i <- 36*(proc.time()[3]-start)) < 360) {
+        rgl.viewpoint(i,i/8);
+    }
+}

Modified: pkg/RQuantLib/inst/ChangeLog
===================================================================
--- pkg/RQuantLib/inst/ChangeLog	2010-08-07 17:21:41 UTC (rev 295)
+++ pkg/RQuantLib/inst/ChangeLog	2010-08-07 18:42:14 UTC (rev 296)
@@ -6,7 +6,10 @@
 	* 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
-	
+
+	* R/arrays.R: New function plotOptionSurface() (from existing demo)
+	* man/EuropeanOptionArrays.Rd: Added documentation
+
 	* 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 17:21:41 UTC (rev 295)
+++ pkg/RQuantLib/man/EuropeanOptionArrays.Rd	2010-08-07 18:42:14 UTC (rev 296)
@@ -2,17 +2,19 @@
 \name{EuropeanOptionArrays}
 \alias{EuropeanOptionArrays}
 \alias{oldEuropeanOptionArrays}
+\alias{plotOptionSurface}
 \title{European Option evaluation using Closed-Form solution}
 \description{
-  The \code{EuropeanOptionArrays} function allows any of the numerical
-  input parameters to be a list, and a list of arrays is returned. Each
-  of the returned arrays has as many dimension as there were lists among
-  the input parameters, and each multi-dimensional array element
+  The \code{EuropeanOptionArrays} function allows any two of the numerical
+  input parameters to be a vector, and a list of matrices is
+  returned for the option value as well as each of the 'greeks'. For
+  each of the returned matrices, each element 
   corresponds to an evaluation under the given set of parameters.
 }
 \usage{
 EuropeanOptionArrays(type, underlying, strike, dividendYield, riskFreeRate, maturity, volatility)
 oldEuropeanOptionArrays(type, underlying, strike, dividendYield, riskFreeRate, maturity, volatility)
+plotOptionSurface(EOres, ylabel="", xlabel="", zlabel="", fov=60) 
 }
 \arguments{
   \item{type}{A string with one of the values \code{call} or \code{put}}
@@ -22,6 +24,11 @@
   \item{riskFreeRate}{(Scalar or list) risk-free rate(s)}
   \item{maturity}{(Scalar or list) time(s) to maturity (in fractional years)}
   \item{volatility}{(Scalar or list) volatilit(y|ies) of the underlying stock}
+  \item{EOres}{result matrix produced by \code{EuropeanOptionArrays}}
+  \item{ylabel}{label for y-axsis}
+  \item{xlabel}{label for x-axsis}
+  \item{zlabel}{label for z-axsis}
+  \item{fov}{viewpoint for 3d rendering}
 }
 \value{
   The \code{EuropeanOptionArrays} function allows any two of the numerical
@@ -71,23 +78,23 @@
 # and look at four of the result arrays: value, delta, gamma, vega
 old.par <- par(no.readonly = TRUE)
 par(mfrow=c(2,2),oma=c(5,0,0,0),mar=c(2,2,2,1))
-plot(EOarr$parameter$underlying, EOarr$value[,1], type='n',
+plot(EOarr$parameters.underlying, EOarr$value[,1], type='n',
      main="option value", xlab="", ylab="") 
 topocol <- topo.colors(length(vol.seq))
 for (i in 1:length(vol.seq))
-  lines(EOarr$parameter$underlying, EOarr$value[,i], col=topocol[i])
-plot(EOarr$parameter$underlying, EOarr$delta[,1],type='n',
+  lines(EOarr$parameters.underlying, EOarr$value[,i], col=topocol[i])
+plot(EOarr$parameters.underlying, EOarr$delta[,1],type='n',
      main="option delta", xlab="", ylab="")
 for (i in 1:length(vol.seq))
-  lines(EOarr$parameter$underlying, EOarr$delta[,i], col=topocol[i])
-plot(EOarr$parameter$underlying, EOarr$gamma[,1],type='n',
+  lines(EOarr$parameters.underlying, EOarr$delta[,i], col=topocol[i])
+plot(EOarr$parameters.underlying, EOarr$gamma[,1],type='n',
      main="option gamma", xlab="", ylab="")
 for (i in 1:length(vol.seq))
-  lines(EOarr$parameter$underlying, EOarr$gamma[,i], col=topocol[i])
-plot(EOarr$parameter$underlying, EOarr$vega[,1],type='n',
+  lines(EOarr$parameters.underlying, EOarr$gamma[,i], col=topocol[i])
+plot(EOarr$parameters.underlying, EOarr$vega[,1],type='n',
      main="option vega", xlab="", ylab="")
 for (i in 1:length(vol.seq))
-  lines(EOarr$parameter$underlying, EOarr$vega[,i], col=topocol[i])
+  lines(EOarr$parameters.underlying, EOarr$vega[,i], col=topocol[i])
 mtext(text=paste("Strike is 100, maturity 1 year, riskless rate 0.03",
         "\nUnderlying price from", und.seq[1],"to", und.seq[length(und.seq)],
         "\nVolatility  from",vol.seq[1], "to",vol.seq[length(vol.seq)]),



More information about the Rquantlib-commits mailing list