[Rcpp-commits] r3524 - in pkg/RcppSMC: . R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Mar 18 20:52:08 CET 2012


Author: adamj
Date: 2012-03-18 20:52:08 +0100 (Sun, 18 Mar 2012)
New Revision: 3524

Modified:
   pkg/RcppSMC/ChangeLog
   pkg/RcppSMC/R/bspfGaussianOptimal.R
   pkg/RcppSMC/R/pfNonlinBS.R
Log:
Standardised plotting output.


Modified: pkg/RcppSMC/ChangeLog
===================================================================
--- pkg/RcppSMC/ChangeLog	2012-03-18 11:30:21 UTC (rev 3523)
+++ pkg/RcppSMC/ChangeLog	2012-03-18 19:52:08 UTC (rev 3524)
@@ -1,5 +1,5 @@
 2012-03-18 Adam Johansen <a.m.johansen at warwick.ac.uk>
-	* src/bspfGaussianOptimal.R tweaked plotting.
+	* src/bspfGaussianOptimal.R tweaked & standardised plotting.
 	* src/pfNonlinBS.R fixed plotting bug.
 	* deprecated moved all rareEvents files here.
 

Modified: pkg/RcppSMC/R/bspfGaussianOptimal.R
===================================================================
--- pkg/RcppSMC/R/bspfGaussianOptimal.R	2012-03-18 11:30:21 UTC (rev 3523)
+++ pkg/RcppSMC/R/bspfGaussianOptimal.R	2012-03-18 19:52:08 UTC (rev 3524)
@@ -1,4 +1,3 @@
-
 blockpfGaussianOpt <- function(data=c(), particles=1000, lag=5, plot=FALSE) {
 
     if (length(data == 0)) {
@@ -13,15 +12,14 @@
 	sqvect = t(res$weight) %*% res$values^2 / sum(res$weight);
 	sdvect = sqrt(sqvect - mvect^2);
  
-       plot(time, mvect, col='dark red', 'l', lty = 1, lwd=3, xlab = 'Iteration',
-       ylab='State', main='Mean and 1, 2 standard deviation credible
-       intervals with observations', xlim = c(0,length(data)), ylim=c(min(mvect - 2.1
-       * (sdvect)), max(mvect+2.1*sdvect))
-       )
-       lines(time, mvect + sdvect, lty=3, col='dark blue')
-       lines(time, mvect - sdvect, lty=3, col='dark blue')
-       lines(time, mvect + 2 * sdvect, lty=2, col='dark blue')
-       lines(time, mvect - 2 * sdvect, lty=2, col='dark blue')
+       plot(time, mvect, 'l', lty = 1, lwd=3, xlab = 'Iteration', ylab='State', 
+            main='Mean and 1, 2 standard deviation credible intervals with observations', 
+	    xlim = c(0,length(data)), ylim=c(min(mvect - 2.1 * (sdvect)), max(mvect+2.1*sdvect)))
+
+       polygon(c(time,seq(length(data),1,-1)),c(mvect-2*sdvect,(mvect+2*sdvect)[seq(length(data),1,-1)]),col='palegreen1',border=NA)
+       polygon(c(time,seq(length(data),1,-1)),c(mvect-1*sdvect,(mvect+1*sdvect)[seq(length(data),1,-1)]),col='palegreen3',border=NA)
+       lines(time, mvect, lwd=2, col='dark blue')
+
        points(time, data, col = 'dark green', cex=0.5)
     }
 

Modified: pkg/RcppSMC/R/pfNonlinBS.R
===================================================================
--- pkg/RcppSMC/R/pfNonlinBS.R	2012-03-18 11:30:21 UTC (rev 3523)
+++ pkg/RcppSMC/R/pfNonlinBS.R	2012-03-18 19:52:08 UTC (rev 3524)
@@ -7,7 +7,7 @@
 
     time <- 1:length(data);
     if (plot) {
-      with(res, plot(time,mean,type='l',xlab='time',ylab='estimate'))
+      with(res, plot(time,mean,type='l',xlab='time',ylab='estimate',xlim = c(0,length(data)), ylim = c(min(mean-2.1*sd),max(mean+2.1*sd))))
       with(res,polygon(c(time,seq(length(data),1,-1)),c(mean-2*sd,(mean+2*sd)[seq(length(data),1,-1)]),col='palegreen1',border=NA))
       with(res,polygon(c(time,seq(length(data),1,-1)),c(mean-1*sd,(mean+1*sd)[seq(length(data),1,-1)]),col='palegreen3',border=NA))
       with(res,lines(time,mean, lwd=2, col='darkblue'))



More information about the Rcpp-commits mailing list