[Pomp-commits] r412 - in pkg: R inst inst/doc

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

Author: kingaa
Date: 2010-11-07 18:21:02 +0100 (Sun, 07 Nov 2010)
New Revision: 412

Modified:
   pkg/R/traj-match.R
   pkg/inst/ChangeLog
   pkg/inst/doc/intro_to_pomp.pdf
   pkg/inst/doc/ou2-first-mif.rda
   pkg/inst/doc/ou2-trajmatch.rda
Log:

- streamline 'traj.match' slightly


Modified: pkg/R/traj-match.R
===================================================================
--- pkg/R/traj-match.R	2010-11-07 16:47:23 UTC (rev 411)
+++ pkg/R/traj-match.R	2010-11-07 17:21:02 UTC (rev 412)
@@ -38,7 +38,7 @@
   x <- trajectory(object,params=params,t0=t0)
   d <- dmeasure(
                 object,
-                y=data.array(object),
+                y=obs(object),
                 x=x,
                 times=time(object),
                 params=as.matrix(params),
@@ -57,7 +57,7 @@
   x <- trajectory(object,params=params,t0=t0)
   d <- dmeasure(
                 object,
-                y=data.array(object),
+                y=obs(object),
                 x=x,
                 times=time(object),
                 params=as.matrix(params),
@@ -66,7 +66,8 @@
   -sum(d)
 }
 
-traj.match <- function (object, start, est, method = c("Nelder-Mead","SANN","subplex"), 
+traj.match <- function (object, start, est,
+                        method = c("Nelder-Mead","SANN","subplex"), 
                         gr = NULL, eval.only = FALSE, ...) {
   
   if (!is(object,'pomp'))
@@ -76,19 +77,24 @@
   
   method <- match.arg(method)
 
-  if (!is.character(est)) stop(sQuote("est")," must be a vector of parameter names")
-  if (!all(est%in%names(start)))
-    stop("traj.match error: parameters named in ",sQuote("est")," must exist in ",sQuote("start"),call.=FALSE)
-  par.est <- which(names(start)%in%est)
+  if (eval.only) {
+    par.est <- integer(0)
+  } else {
+    if (missing(est))
+      stop("traj.match error: ",sQuote("est")," must be specified")
+    if (!is.character(est)) stop(sQuote("est")," must be a vector of parameter names")
+    if (!all(est%in%names(start)))
+      stop("traj.match error: parameters named in ",sQuote("est")," must exist in ",sQuote("start"),call.=FALSE)
+    par.est <- which(names(start)%in%est)
+    guess <- start[par.est]
+  }
 
-  guess <- start[par.est]
   t0 <- timezero(object)
   obj <- as(object,"pomp")
 
   obj.fn <- function (x) {
     p <- start
     p[par.est] <- x
-    x <- trajectory(obj,params=p,t0=t0)
     d <- dmeasure(
                   obj,
                   y=obs(obj),
@@ -103,10 +109,11 @@
   if (eval.only) {
 
     coef(obj,names(start)) <- unname(start)
-    val <- obj.fn(guess)
+    obj at states[,] <- trajectory(obj,t0=t0)[,1,]
+    val <- obj.fn(start)
     conv <- NA
     evals <- c(1,0)
-    msg <- paste("no optimization performed")
+    msg <- "no optimization performed"
     
   } else {
 

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-11-07 16:47:23 UTC (rev 411)
+++ pkg/inst/ChangeLog	2010-11-07 17:21:02 UTC (rev 412)
@@ -1,3 +1,15 @@
+2010-11-07  kingaa
+
+	* [r411] R/nlf-objfun.R, R/spect.R, inst/doc/intro_to_pomp.Rnw,
+	  man/basic-probes.Rd, man/spect.Rd: - replace 'data.array' with
+	  'obs' as the preferred method
+	* [r410] R/traj-match.R, R/trajectory-pomp.R, inst/ChangeLog,
+	  src/sir.c: - fix traj-match objective function
+	  - minor tweak to trajectory generic
+	  - make the variables 'cases' in SIR trajectories integer-valued
+	* [r409] src/probe_acf.c, src/synth_lik.c: - get rid of some unused
+	  varibles
+
 2010-11-05  kingaa
 
 	* [r407] DESCRIPTION, R/mif-class.R, R/mif.R, R/particles-mif.R,

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

Modified: pkg/inst/doc/ou2-first-mif.rda
===================================================================
(Binary files differ)

Modified: pkg/inst/doc/ou2-trajmatch.rda
===================================================================
(Binary files differ)