[Rcpp-commits] r3513 - in pkg/RcppSMC: . R man src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Mar 17 03:23:34 CET 2012


Author: edd
Date: 2012-03-17 03:23:32 +0100 (Sat, 17 Mar 2012)
New Revision: 3513

Modified:
   pkg/RcppSMC/ChangeLog
   pkg/RcppSMC/NAMESPACE
   pkg/RcppSMC/R/pfEx.R
   pkg/RcppSMC/man/pfEx.Rd
   pkg/RcppSMC/src/pf.cpp
Log:
plotting callback


Modified: pkg/RcppSMC/ChangeLog
===================================================================
--- pkg/RcppSMC/ChangeLog	2012-03-17 01:15:56 UTC (rev 3512)
+++ pkg/RcppSMC/ChangeLog	2012-03-17 02:23:32 UTC (rev 3513)
@@ -1,8 +1,11 @@
 2012-03-16  Dirk Eddelbuettel  <edd at dexter>
 
-	* src/pf.cpp: Changed to get example data from R and pass it to a
-	vector of cv_obs
-	* R/pfEx.R: Added a helper func. to read data, restructured pfEx()
+	* src/pf.cpp:
+	  - Changed to get example data from R and pass to vector of cv_obs
+	  - Added optional plotting callback to visualize estimation progress
+	* R/pfEx.R:
+	  - Added a helper func. to read data, restructured pfEx()
+	  - Support optional plotting callback; provided sample function
 	* man/pfEx.Rd: Updated accordingly
 
 2012-03-16  Adam Johansen <a.m.johansen at warwick.ac.uk>

Modified: pkg/RcppSMC/NAMESPACE
===================================================================
--- pkg/RcppSMC/NAMESPACE	2012-03-17 01:15:56 UTC (rev 3512)
+++ pkg/RcppSMC/NAMESPACE	2012-03-17 02:23:32 UTC (rev 3513)
@@ -3,5 +3,6 @@
 
 export(blockpfGaussianOpt,
        pfEx,
+       pfExOnlinePlot,
        pfNonlinBS,
        rareEventsEx)

Modified: pkg/RcppSMC/R/pfEx.R
===================================================================
--- pkg/RcppSMC/R/pfEx.R	2012-03-17 01:15:56 UTC (rev 3512)
+++ pkg/RcppSMC/R/pfEx.R	2012-03-17 02:23:32 UTC (rev 3513)
@@ -1,20 +1,35 @@
 
-pfEx<- function(data, particles=1000, plot=FALSE) {
+pfEx<- function(data, particles=1000, plot=FALSE, onlinePlot) {
 
     # if no data supplied, use default
     if (missing(data)) data <- getEx1Data()
 
+    if (missing(onlinePlot)) {
+        useOnline <- FALSE
+        onlinePlot <- function() { NULL }
+    } else {
+        useOnline <- TRUE
+        # set up x11
+        x11(width=3,height=3)
+        par(mar=c(3,3,1,1),cex=0.8, pch=19)
+    }
+
     # more eloquent tests can be added
     stopifnot(nrow(data) > 0,
               ncol(data) == 2,
-              colnames(data) == c("x", "y"))
+              colnames(data) == c("x", "y"),
+              class(onlinePlot) == "function")
 
-    res <- .Call("pf", as.matrix(data), particles, package="RcppSMC")
+    res <- .Call("pf", as.matrix(data),
+                 particles,
+                 useOnline,
+                 onlinePlot,
+                 package="RcppSMC")
 
     if (plot) {
-      ## plot 5.1 from vignette / paper
-      with(data, plot(x, y, col="red"))
-      with(res, lines(Xm, Ym, lty="dashed"))
+        ## plot 5.1 from vignette / paper
+        with(data, plot(x, y, col="red"))
+        with(res, lines(Xm, Ym, lty="dashed"))
     }
 
     invisible(res)
@@ -28,4 +43,8 @@
     invisible(dat)
 }
 
+pfExOnlinePlot <- function(xm, ym) {
+    plot(xm, ym, ylim=c(-7,0), xlim=c(2,14))
+    Sys.sleep(0.05)
+}
 

Modified: pkg/RcppSMC/man/pfEx.Rd
===================================================================
--- pkg/RcppSMC/man/pfEx.Rd	2012-03-17 01:15:56 UTC (rev 3512)
+++ pkg/RcppSMC/man/pfEx.Rd	2012-03-17 02:23:32 UTC (rev 3513)
@@ -1,14 +1,20 @@
 \name{pfEx}
 \alias{pfEx}
+\alias{pfExOnlinePlot}
 \title{Particle Filter Example}
 \description{
   The \code{pfEx} function provides a simple example for
   \pkg{RcppSMC}. It is based on the first example in \code{SMCTC} and
   the discussion in Section 5.1 of Johansen (2009). A simple 'vehicle
   tracking' problem of 100 observations is solved with 1000 particles.
+
+  The \code{pfExOnlinePlot} function provides a simple default
+  \sQuote{online} plotting function that is invoked during the
+  estimation process. 
 }
 \usage{
   pfEx(data, particles=1000, plot=FALSE) 
+  pfExOnlinePlot(xm, ym)
 }
 \arguments{
   \item{data}{A two-column matrix or dataframe containing x and y
@@ -17,6 +23,8 @@
   \item{particles}{An integer specifying the number of particles.}
   \item{plot}{A boolean variable describing whether plot should
     illustrate the estimated path along with the data.}
+  \item{xm}{Vector with x position.}
+  \item{ym}{Vector with y position.}
 }
 \value{
   The function returns a \code{data.frame} containing as many rows as in
@@ -28,6 +36,10 @@
   \pkg{RcppSMC}. It is based on the \code{pf} example in the
   \code{SMCTC} library, and discussed in the Section 5.1 of his
   corresponding paper (Johansen, 2009).
+
+  Using the simple \code{pfExOnlinePlot} function illustrates how
+  callbacks into R, for example for plotting,  can be made during the
+  operation of SMC algorithm.
 }
 \references{
   A. M. Johansen. SMCTC: Sequential Monte Carlo in C++.

Modified: pkg/RcppSMC/src/pf.cpp
===================================================================
--- pkg/RcppSMC/src/pf.cpp	2012-03-17 01:15:56 UTC (rev 3512)
+++ pkg/RcppSMC/src/pf.cpp	2012-03-17 02:23:32 UTC (rev 3513)
@@ -51,7 +51,7 @@
 
 // pf() function callable from R via Rcpp:: essentially the same as main() from pf.cc 
 // minor interface change to pass data down as matrix, rather than a filename
-extern "C" SEXP pf(SEXP dataS, SEXP partS) { 	
+extern "C" SEXP pf(SEXP dataS, SEXP partS, SEXP usefS, SEXP funS) { 	
 
     long lIterates;
 
@@ -59,6 +59,8 @@
 
         //std::string filename = Rcpp::as<std::string>(fileS);
         unsigned long lNumber = Rcpp::as<unsigned long>(partS);
+        bool useF = Rcpp::as<bool>(usefS);
+        Rcpp::Function f(funS);
 
         // Load observations -- or rather copy them in from R
         //lIterates = load_data(filename.c_str(), &y);
@@ -87,6 +89,8 @@
             Xv(n) = Sampler.Integrate(integrand_var_x, (void*)&Xm(n));
             Ym(n) = Sampler.Integrate(integrand_mean_y, NULL);
             Yv(n) = Sampler.Integrate(integrand_var_y, (void*)&Ym(n));
+
+            if (useF) f(Xm, Xv, Ym, Yv);
         }
 
         return Rcpp::DataFrame::create(Rcpp::Named("Xm") = Xm,



More information about the Rcpp-commits mailing list