[Pomp-commits] r566 - in pkg: . R inst

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

Author: kingaa
Date: 2011-11-22 22:30:22 +0100 (Tue, 22 Nov 2011)
New Revision: 566

Modified:
   pkg/DESCRIPTION
   pkg/R/bsmc.R
   pkg/inst/TODO
Log:
- fix bug in 'bsmc' that arises when the state space is 1-D (add drop=FALSE flag to [] operation)


Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2011-11-12 15:41:19 UTC (rev 565)
+++ pkg/DESCRIPTION	2011-11-22 21:30:22 UTC (rev 566)
@@ -1,8 +1,8 @@
 Package: pomp
 Type: Package
 Title: Statistical inference for partially observed Markov processes
-Version: 0.39-4
-Date: 2011-11-11
+Version: 0.39-5
+Date: 2011-11-22
 Author: Aaron A. King, Edward L. Ionides, Carles Breto, Steve Ellner, Bruce Kendall, Helen Wearing, Matthew J. Ferrari, Michael Lavine, Daniel C. Reuman
 Maintainer: Aaron A. King <kingaa at umich.edu>
 URL: http://pomp.r-forge.r-project.org

Modified: pkg/R/bsmc.R
===================================================================
--- pkg/R/bsmc.R	2011-11-12 15:41:19 UTC (rev 565)
+++ pkg/R/bsmc.R	2011-11-22 21:30:22 UTC (rev 566)
@@ -169,6 +169,7 @@
               k <- sample.int(n=Np,size=Np,replace=TRUE,prob=g)
               params <- params[,k]
               m <- m[,k]
+              g <- g[k]
 
               ## sample new parameter vector as per L&W AGM (3) and Liu & West eq(3.2)
               pvec <- try(
@@ -189,7 +190,7 @@
               ## sample current state vector x^(g)_(t+1) as per L&W AGM (4)
               X <- rprocess(
                             object,
-                            xstart=x[,k],
+                            xstart=x[,k,drop=FALSE],
                             times=times[c(nt,nt+1)],
                             params=params
                             )[,,2,drop=FALSE]
@@ -203,7 +204,7 @@
                                 params=params
                                 )
               ## evaluate weights as per L&W AGM (5)
-              weights <- numer/g[k]
+              weights <- numer/g
               
               ## apply box constraints as per the priors          
               for (j in seq_len(Np)) {
@@ -249,11 +250,11 @@
                 eff.sample.size[nt] <- 0
               } else {                  # not all particles are lost
                 ## compute log-likelihood
-                loglik[nt] <- log(mean(weights))  
+                loglik[nt] <- log(mean(weights))
                 weights[failures] <- 0
                 weights <- weights/sum(weights)
                 ## compute effective sample-size
-                eff.sample.size[nt] <- 1/(weights%*%weights) 
+                eff.sample.size[nt] <- 1/crossprod(weights)
               }
 
               if (verbose) {

Modified: pkg/inst/TODO
===================================================================
--- pkg/inst/TODO	2011-11-12 15:41:19 UTC (rev 565)
+++ pkg/inst/TODO	2011-11-22 21:30:22 UTC (rev 566)
@@ -1,3 +1,5 @@
+* unit tests for 'sannbox'
+
 * Create objective functions for 'probe.match', 'traj.match', and
    'spect.match' so that  users can roll their own optimization
    routines.  Use 'nloptr' as the target optimizer package?