[Pomp-commits] r415 - in pkg: . R inst/doc tests

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

Author: kingaa
Date: 2010-11-09 20:07:29 +0100 (Tue, 09 Nov 2010)
New Revision: 415

Modified:
   pkg/DESCRIPTION
   pkg/R/traj-match.R
   pkg/inst/doc/advanced_topics_in_pomp.pdf
   pkg/inst/doc/intro_to_pomp.pdf
   pkg/tests/ou2-trajmatch.R
   pkg/tests/ou2-trajmatch.Rout.save
Log:
- fix bug in 'traj.match'


Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2010-11-08 20:57:14 UTC (rev 414)
+++ pkg/DESCRIPTION	2010-11-09 19:07:29 UTC (rev 415)
@@ -2,7 +2,7 @@
 Type: Package
 Title: Statistical inference for partially observed Markov processes
 Version: 0.36-1
-Date: 2010-11-08
+Date: 2010-11-09
 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>

Modified: pkg/R/traj-match.R
===================================================================
--- pkg/R/traj-match.R	2010-11-08 20:57:14 UTC (rev 414)
+++ pkg/R/traj-match.R	2010-11-09 19:07:29 UTC (rev 415)
@@ -45,31 +45,40 @@
 
   t0 <- timezero(object)
   obj <- as(object,"pomp")
+  coef(obj,names(start)) <- unname(start)
+  pmat <- as.matrix(start)
 
-  obj.fn <- function (x) {
-    p <- start
-    p[par.est] <- x
-    d <- dmeasure(
-                  obj,
-                  y=obs(obj),
-                  x=trajectory(obj,params=p,t0=t0),
-                  times=time(obj),
-                  params=as.matrix(p),
-                  log=TRUE
-                  )
-    -sum(d)
-  }
-
   if (eval.only) {
 
-    coef(obj,names(start)) <- unname(start)
-    val <- obj.fn(start)
+    val <- -sum(
+                dmeasure(
+                         obj,
+                         y=obs(obj),
+                         x=trajectory(obj,params=pmat,t0=t0),
+                         times=time(obj),
+                         params=pmat,
+                         log=TRUE
+                         )
+                )
     conv <- NA
     evals <- c(1,0)
     msg <- "no optimization performed"
     
   } else {
 
+    obj.fn <- function (x) {
+      pmat[par.est,] <- x
+      d <- dmeasure(
+                    obj,
+                    y=obs(obj),
+                    x=trajectory(obj,params=pmat,t0=t0),
+                    times=time(obj),
+                    params=pmat,
+                    log=TRUE
+                    )
+      -sum(d)
+    }
+
     if (method=="subplex") {
 
       opt <- subplex::subplex(
@@ -87,6 +96,7 @@
                    method=method,
                    control=list(...)
                    )
+      
     }
 
     coef(obj,names(opt$par)) <- unname(opt$par)

Modified: pkg/inst/doc/advanced_topics_in_pomp.pdf
===================================================================
(Binary files differ)

Modified: pkg/inst/doc/intro_to_pomp.pdf
===================================================================
(Binary files differ)

Modified: pkg/tests/ou2-trajmatch.R
===================================================================
--- pkg/tests/ou2-trajmatch.R	2010-11-08 20:57:14 UTC (rev 414)
+++ pkg/tests/ou2-trajmatch.R	2010-11-09 19:07:29 UTC (rev 415)
@@ -4,7 +4,6 @@
 true.p <- coef(ou2)
 simdata <- simulate(ou2,nsim=5,params=true.p,seed=394885)
 guess.p <- true.p
-guess.p[grep('sigma',names(guess.p))] <- 0
 
 x <- sapply(
             simdata,

Modified: pkg/tests/ou2-trajmatch.Rout.save
===================================================================
--- pkg/tests/ou2-trajmatch.Rout.save	2010-11-08 20:57:14 UTC (rev 414)
+++ pkg/tests/ou2-trajmatch.Rout.save	2010-11-09 19:07:29 UTC (rev 415)
@@ -21,7 +21,6 @@
 > true.p <- coef(ou2)
 > simdata <- simulate(ou2,nsim=5,params=true.p,seed=394885)
 > guess.p <- true.p
-> guess.p[grep('sigma',names(guess.p))] <- 0
 > 
 > x <- sapply(
 +             simdata,