[Rcpp-commits] r3006 - in pkg/RcppArmadillo: . inst inst/examples

[noreply at r-forge.r-project.org]

Author: edd
Date: 2011-04-22 23:04:25 +0200 (Fri, 22 Apr 2011)
New Revision: 3006

Added:
   pkg/RcppArmadillo/inst/examples/
   pkg/RcppArmadillo/inst/examples/varSimulation.r
Modified:
   pkg/RcppArmadillo/ChangeLog
   pkg/RcppArmadillo/inst/NEWS
Log:
added new example contributed by Lance Bachmeier, slightly reworked and extended


Modified: pkg/RcppArmadillo/ChangeLog
===================================================================
--- pkg/RcppArmadillo/ChangeLog	2011-04-19 13:46:09 UTC (rev 3005)
+++ pkg/RcppArmadillo/ChangeLog	2011-04-22 21:04:25 UTC (rev 3006)
@@ -1,3 +1,8 @@
+2011-04-22  Dirk Eddelbuettel  <edd at debian.org>
+
+	* inst/examples/varSimulation.r: New example simulating a first-order
+	vector autoregression data set via R, compiled R and RcppArmadillo 
+
 2011-04-18  Dirk Eddelbuettel  <edd at debian.org>
 
 	* DESCRIPTION: Release 0.2.19

Modified: pkg/RcppArmadillo/inst/NEWS
===================================================================
--- pkg/RcppArmadillo/inst/NEWS	2011-04-19 13:46:09 UTC (rev 3005)
+++ pkg/RcppArmadillo/inst/NEWS	2011-04-22 21:04:25 UTC (rev 3006)
@@ -1,3 +1,8 @@
+0.2.20  2011-xx-yy
+
+    o   Added a new subdirectory examples/ seeded with a nice Vector
+        Autoregression simulation simulation example by Lance Bachmeier
+
 0.2.19  2011-04-18
 
     o   Upgraded to Armadillo version 1.2.0 "Unscrupulous Carbon Emitter"

Added: pkg/RcppArmadillo/inst/examples/varSimulation.r
===================================================================
--- pkg/RcppArmadillo/inst/examples/varSimulation.r	                        (rev 0)
+++ pkg/RcppArmadillo/inst/examples/varSimulation.r	2011-04-22 21:04:25 UTC (rev 3006)
@@ -0,0 +1,66 @@
+#!/usr/bin/r
+##
+## varSimulation.r: Simulation of first-order vector autoregression data
+##
+## Copyright (C)  2011  Lance Bachmeier and Dirk Eddelbuettel
+##
+## This file is part of RcppArmadillo.
+##
+## RcppArmadillo is free software: you can redistribute it and/or modify it
+## under the terms of the GNU General Public License as published by
+## the Free Software Foundation, either version 2 of the License, or
+## (at your option) any later version.
+##
+## RcppArmadillo is distributed in the hope that it will be useful, but
+## WITHOUT ANY WARRANTY; without even the implied warranty of
+## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+## GNU General Public License for more details.
+##
+## You should have received a copy of the GNU General Public License
+## along with RcppArmadillo.  If not, see <http://www.gnu.org/licenses/>.
+
+suppressMessages(require(inline))
+
+code <- '
+  arma::mat coeff = Rcpp::as<arma::mat>(a);
+  arma::mat errors = Rcpp::as<arma::mat>(e);
+  int m = errors.n_rows; int n = errors.n_cols;
+  arma::mat simdata(m,n);
+  simdata.row(0) = arma::zeros<arma::mat>(1,n);
+  for (int row=1; row<m; row++) {
+    simdata.row(row) = simdata.row(row-1)*trans(coeff)+errors.row(row);
+  }
+  return Rcpp::wrap(simdata);
+'
+
+rcppSim <- cxxfunction(signature(a="numeric",e="numeric"),
+                       code,plugin="RcppArmadillo")
+
+a <- matrix(c(0.5,0.1,0.1,0.5),nrow=2)
+e <- matrix(rnorm(10000),ncol=2)
+rcppData <- rcppSim(a,e)
+
+rSim <- function(coeff,errors) {
+  simdata <- matrix(0,nrow(errors),ncol(errors))
+  for (row in 2:nrow(errors)) {
+    simdata[row,] = coeff %*% simdata[(row-1),] + errors[row,]
+  }
+  return(simdata)
+}
+rData <- rSim(a,e)
+stopifnot(all.equal(rcppData, rData))
+
+suppressMessages(require(compiler))
+compRsim <- cmpfun(rSim)
+
+compRData <- compRsim(a,e)
+stopifnot(all.equal(rcppData, compRData))
+
+library(rbenchmark)
+res <- benchmark(rcppSim(a,e),
+                 rSim(a,e),
+                 compRsim(a,e),
+                 columns=c("test", "replications", "elapsed",
+                           "relative", "user.self", "sys.self"),
+                 order="relative")
+print(res)