[Pomp-commits] r1169 - in pkg/pomp: . R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jun 4 14:22:19 CEST 2015


Author: kingaa
Date: 2015-06-04 14:22:19 +0200 (Thu, 04 Jun 2015)
New Revision: 1169

Modified:
   pkg/pomp/DESCRIPTION
   pkg/pomp/R/bsmc.R
   pkg/pomp/R/bsmc2.R
   pkg/pomp/R/generics.R
   pkg/pomp/R/mif-methods.R
   pkg/pomp/R/mif.R
   pkg/pomp/R/minim.R
   pkg/pomp/R/nlf-objfun.R
   pkg/pomp/R/nlf.R
   pkg/pomp/R/pfilter.R
   pkg/pomp/R/pomp-methods.R
   pkg/pomp/R/probe-match.R
   pkg/pomp/R/traj-match.R
Log:
- fix internal calls to 'partrans' to be consistent with 0.65-1

Modified: pkg/pomp/DESCRIPTION
===================================================================
--- pkg/pomp/DESCRIPTION	2015-06-01 21:06:19 UTC (rev 1168)
+++ pkg/pomp/DESCRIPTION	2015-06-04 12:22:19 UTC (rev 1169)
@@ -1,8 +1,8 @@
 Package: pomp
 Type: Package
 Title: Statistical Inference for Partially Observed Markov Processes
-Version: 0.65-2
-Date: 2015-06-01
+Version: 0.65-3
+Date: 2015-06-02
 Authors at R: c(person(given=c("Aaron","A."),family="King",
 		role=c("aut","cre"),email="kingaa at umich.edu"),
 	  person(given=c("Edward","L."),family="Ionides",role=c("aut")),

Modified: pkg/pomp/R/bsmc.R
===================================================================
--- pkg/pomp/R/bsmc.R	2015-06-01 21:06:19 UTC (rev 1168)
+++ pkg/pomp/R/bsmc.R	2015-06-04 12:22:19 UTC (rev 1169)
@@ -72,7 +72,7 @@
     params <- rprior(object,params=parmat(params,Np))
   
   if (transform)
-    params <- partrans(object,params,dir="inverse",
+    params <- partrans(object,params,dir="toEstimationScale",
                        .getnativesymbolinfo=ptsi.inv)
   ptsi.inv <- FALSE
   
@@ -127,7 +127,7 @@
   xstart <- init.state(
                        object,
                        params=if (transform) {
-                         partrans(object,params,dir="forward",
+                         partrans(object,params,dir="fromEstimationScale",
                                   .getnativesymbolinfo=ptsi.for)
                        } else {
                          params
@@ -172,7 +172,7 @@
                       xstart=parmat(x,nrep=ntries),
                       times=times[c(nt,nt+1)],
                       params=if (transform) {
-                        partrans(object,params,dir="forward",
+                        partrans(object,params,dir="fromEstimationScale",
                                  .getnativesymbolinfo=ptsi.for)
                       } else {
                         params
@@ -194,7 +194,7 @@
                   x=mu,
                   times=times[nt+1],
                   params=if (transform) {
-                    partrans(object,m,dir="forward",
+                    partrans(object,m,dir="fromEstimationScale",
                              .getnativesymbolinfo=ptsi.for)
                   } else {
                     m
@@ -227,7 +227,7 @@
     params[estind,] <- m[estind,]+t(pvec)
 
     if (transform)
-      tparams <- partrans(object,params,dir="forward",
+      tparams <- partrans(object,params,dir="fromEstimationScale",
                           .getnativesymbolinfo=ptsi.for)
     
     ## sample current state vector x^(g)_(t+1) as per L&W AGM (4)
@@ -436,8 +436,8 @@
             if (missing(pars)) pars <- x at est
             if (missing(thin)) thin <- Inf
             bsmc.plot(
-                      prior=if (x at transform) partrans(x,x at prior,dir="forward") else x at prior,
-                      post=if (x at transform) partrans(x,x at post,dir="forward") else x at post,
+                      prior=if (x at transform) partrans(x,x at prior,dir="fromEstimationScale") else x at prior,
+                      post=if (x at transform) partrans(x,x at post,dir="fromEstimationScale") else x at post,
                       pars=pars,
                       thin=thin,
                       ...

Modified: pkg/pomp/R/bsmc2.R
===================================================================
--- pkg/pomp/R/bsmc2.R	2015-06-01 21:06:19 UTC (rev 1168)
+++ pkg/pomp/R/bsmc2.R	2015-06-04 12:22:19 UTC (rev 1169)
@@ -47,7 +47,7 @@
     params <- rprior(object,params=parmat(params,Np))
   
   if (transform)
-    params <- partrans(object,params,dir="inverse",
+    params <- partrans(object,params,dir="toEstimationScale",
                        .getnativesymbolinfo=ptsi.inv)
   ptsi.inv <- FALSE
   
@@ -76,7 +76,7 @@
   xstart <- init.state(
                        object,
                        params=if (transform) {
-                         partrans(object,params,dir="forward",
+                         partrans(object,params,dir="fromEstimationScale",
                                   .getnativesymbolinfo=ptsi.for)
                        } else {
                          params
@@ -134,7 +134,7 @@
     params[estind,] <- m[estind,]+t(pert)
 
     if (transform)
-      tparams <- partrans(object,params,dir="forward",
+      tparams <- partrans(object,params,dir="fromEstimationScale",
                           .getnativesymbolinfo=ptsi.for)
     
     xpred <- rprocess(

Modified: pkg/pomp/R/generics.R
===================================================================
--- pkg/pomp/R/generics.R	2015-06-01 21:06:19 UTC (rev 1168)
+++ pkg/pomp/R/generics.R	2015-06-04 12:22:19 UTC (rev 1169)
@@ -26,7 +26,7 @@
 setGeneric("states",function(object,...)standardGeneric("states"))
 setGeneric("timezero",function(object,...)standardGeneric("timezero"))
 setGeneric("timezero<-",function(object,...,value)standardGeneric("timezero<-"))
-setGeneric("partrans",function(object,params,dir=c("forward","inverse"),...)standardGeneric("partrans"))
+setGeneric("partrans",function(object,params,dir,...)standardGeneric("partrans"))
 setGeneric("logLik",function(object,...)standardGeneric("logLik"))
 
 ## internals

Modified: pkg/pomp/R/mif-methods.R
===================================================================
--- pkg/pomp/R/mif-methods.R	2015-06-01 21:06:19 UTC (rev 1168)
+++ pkg/pomp/R/mif-methods.R	2015-06-04 12:22:19 UTC (rev 1169)
@@ -54,7 +54,7 @@
                       partrans(
                                object,
                                params=t(object at conv.rec[,pars.proper]),
-                               dir="forward"
+                               dir="fromEstimationScale"
                                )
                       ),
                     object at conv.rec[,pars.improper]

Modified: pkg/pomp/R/mif.R
===================================================================
--- pkg/pomp/R/mif.R	2015-06-01 21:06:19 UTC (rev 1168)
+++ pkg/pomp/R/mif.R	2015-06-04 12:22:19 UTC (rev 1169)
@@ -21,7 +21,7 @@
          )
 
 
-default.pomp.particles.fun <- function (Np, center, sd, ...) {
+default.mif.particles.fun <- function (Np, center, sd, ...) {
   matrix(
          data=rnorm(
            n=Np*length(center),
@@ -37,7 +37,7 @@
          )
 }
 
-cooling.function <- function (type, perobs, fraction, ntimes) {
+mif1.cooling.function <- function (type, perobs, fraction, ntimes) {
   switch(
          type,
          geometric={
@@ -108,7 +108,7 @@
          )
   
   if (transform)
-    start <- partrans(object,start,dir="inverse")
+    start <- partrans(object,start,dir="toEstimationScale")
   
   start.names <- names(start)
   if (is.null(start.names))
@@ -212,12 +212,12 @@
   if ((length(cooling.fraction.50)!=1)||(cooling.fraction.50<0)||(cooling.fraction.50>1))
     stop("mif error: ",sQuote("cooling.fraction.50")," must be a number between 0 and 1",call.=FALSE)
   
-  cooling <- cooling.function(
-                              type=cooling.type,
-                              perobs=(method=="mif2"),
-                              fraction=cooling.fraction.50,
-                              ntimes=ntimes
-                              )
+  cooling <- mif1.cooling.function(
+                                   type=cooling.type,
+                                   perobs=(method=="mif2"),
+                                   fraction=cooling.fraction.50,
+                                   ntimes=ntimes
+                                   )
 
   if ((method=="mif2")&&(Np[1L]!=Np[ntimes+1]))
     stop("the first and last values of ",sQuote("Np")," must agree when method = ",sQuote("mif2"))
@@ -350,7 +350,7 @@
   } ### end of main loop
 
   ## back transform the parameter estimate if necessary
-  if (transform) theta <- partrans(pfp,theta,dir="forward")
+  if (transform) theta <- partrans(pfp,theta,dir="fromEstimationScale")
   
   pompUnload(object)
 
@@ -412,7 +412,7 @@
             cooling.type <- match.arg(cooling.type)
             
             if (missing(particles)) { # use default: normal distribution
-              particles <- default.pomp.particles.fun
+              particles <- default.mif.particles.fun
             } else {
               particles <- match.fun(particles)
               if (!all(c('Np','center','sd','...')%in%names(formals(particles))))

Modified: pkg/pomp/R/minim.R
===================================================================
--- pkg/pomp/R/minim.R	2015-06-01 21:06:19 UTC (rev 1168)
+++ pkg/pomp/R/minim.R	2015-06-04 12:22:19 UTC (rev 1169)
@@ -10,10 +10,10 @@
     stop(sQuote("start")," must be supplied")
 
   if (transform) {
-    start <- partrans(object,start,dir="inverse")
+    start <- partrans(object,start,dir="toEstimationScale")
     if (is.null(names(start))||(!all(est%in%names(start))))
       stop(sQuote("est")," must refer to parameters named in ",
-           sQuote("partrans(object,start,dir=\"inverse\")"))
+           sQuote("partrans(object,start,dir=\"toEstimationScale\")"))
     guess <- start[est]
   } else {
     if (is.null(names(start))||(!all(est%in%names(start))))
@@ -62,7 +62,7 @@
   }
 
   if (transform)
-    start <- partrans(object,start,dir='forward')
+    start <- partrans(object,start,dir="fromEstimationScale")
   
   pompUnload(object)
 

Modified: pkg/pomp/R/nlf-objfun.R
===================================================================
--- pkg/pomp/R/nlf-objfun.R	2015-06-01 21:06:19 UTC (rev 1168)
+++ pkg/pomp/R/nlf-objfun.R	2015-06-04 12:22:19 UTC (rev 1169)
@@ -15,7 +15,7 @@
   params[par.index] <- params.fitted
   
   if (transform)
-    params <- partrans(object,params,dir="forward")
+    params <- partrans(object,params,dir="fromEstimationScale")
 
   ## Evaluates the NLF objective function given a POMP object.
   ## Version 0.1, 3 Dec. 2007, Bruce E. Kendall & Stephen P. Ellner

Modified: pkg/pomp/R/nlf.R
===================================================================
--- pkg/pomp/R/nlf.R	2015-06-01 21:06:19 UTC (rev 1168)
+++ pkg/pomp/R/nlf.R	2015-06-04 12:22:19 UTC (rev 1169)
@@ -64,7 +64,7 @@
   if (eval.only) est <- character(0)
   if (missing(start)) start <- coef(object)
   if (transform)
-    params <- partrans(object,start,dir="inverse")
+    params <- partrans(object,start,dir="toEstimationScale")
   else
     params <- start
 
@@ -161,7 +161,7 @@
     }
 
     params[par.index] <- opt$par
-    opt$params <- if (transform) partrans(object,params,dir="forward") else params
+    opt$params <- if (transform) partrans(object,params,dir="fromEstimationScale") else params
     
   }
 

Modified: pkg/pomp/R/pfilter.R
===================================================================
--- pkg/pomp/R/pfilter.R	2015-06-01 21:06:19 UTC (rev 1168)
+++ pkg/pomp/R/pfilter.R	2015-06-04 12:22:19 UTC (rev 1169)
@@ -109,7 +109,7 @@
   x <- init.state(
                   object,
                   params=if (transform) {
-                    partrans(object,params,dir="forward",
+                    partrans(object,params,dir="fromEstimationScale",
                              .getnativesymbolinfo=ptsi.for)
                   } else {
                     params
@@ -210,7 +210,7 @@
     }
     
     ## transform the parameters if necessary
-    if (transform) tparams <- partrans(object,params,dir="forward",
+    if (transform) tparams <- partrans(object,params,dir="fromEstimationScale",
                                        .getnativesymbolinfo=ptsi.for)
     ptsi.for <- FALSE
     

Modified: pkg/pomp/R/pomp-methods.R
===================================================================
--- pkg/pomp/R/pomp-methods.R	2015-06-01 21:06:19 UTC (rev 1168)
+++ pkg/pomp/R/pomp-methods.R	2015-06-04 12:22:19 UTC (rev 1169)
@@ -26,19 +26,23 @@
 
 ## parameter transformations
 partrans.internal <- function (object, params,
-                               dir = c("fromEstimationScale","toEstimationScale",
+                               dir = c("fromEstimationScale",
+                                 "toEstimationScale",
                                  "forward","inverse"),
                                .getnativesymbolinfo = TRUE, ...) {
   if (!object at has.trans) return(params)
   pompLoad(object)
-  dir <- switch(match.arg(dir),fromEstimationScale=1L,toEstimationScale=-1L,forward=1L,inverse=-1L)
+  dir <- switch(match.arg(dir),fromEstimationScale=1L,toEstimationScale=-1L,
+                forward=1L,inverse=-1L)
   rv <- .Call(do_partrans,object,params,dir,.getnativesymbolinfo)
   pompUnload(object)
   rv
 }
 
 setMethod("partrans","pomp",
-          function (object, params, dir = c("fromEstimationScale","toEstimationScale", "forward","inverse"),...)
+          function (object, params, dir = c("fromEstimationScale",
+                                      "toEstimationScale", "forward","inverse"),
+                    ...)
           partrans.internal(object=object,params=params,dir=dir,...)
           )
 

Modified: pkg/pomp/R/probe-match.R
===================================================================
--- pkg/pomp/R/probe-match.R	2015-06-01 21:06:19 UTC (rev 1168)
+++ pkg/pomp/R/probe-match.R	2015-06-04 12:22:19 UTC (rev 1169)
@@ -47,7 +47,7 @@
   if ((!is.numeric(params))||(is.null(names(params))))
     stop(sQuote("params")," must be a named numeric vector")
   if (transform)
-    params <- partrans(object,params,dir="inverse")
+    params <- partrans(object,params,dir="toEstimationScale")
   par.est.idx <- match(est,names(params))
   if (any(is.na(par.est.idx)))
     stop("parameter(s): ",sQuote(est[is.na(par.est.idx)])," not found in ",sQuote("params"))
@@ -70,7 +70,7 @@
     params[par.est.idx] <- par
     
     if (transform)
-      tparams <- partrans(object,params,dir="forward")
+      tparams <- partrans(object,params,dir="fromEstimationScale")
 
     ## apply probes to model simulations
     simval <- .Call(

Modified: pkg/pomp/R/traj-match.R
===================================================================
--- pkg/pomp/R/traj-match.R	2015-06-01 21:06:19 UTC (rev 1168)
+++ pkg/pomp/R/traj-match.R	2015-06-04 12:22:19 UTC (rev 1169)
@@ -42,7 +42,7 @@
   if ((!is.numeric(params))||(is.null(names(params))))
     stop(sQuote("params")," must be a named numeric vector")
   if (transform)
-    params <- partrans(object,params,dir="inverse")
+    params <- partrans(object,params,dir="toEstimationScale")
   par.est.idx <- match(est,names(params))
   if (any(is.na(par.est.idx)))
     stop("parameter(s): ",sQuote(est[is.na(par.est.idx)])," not found in ",sQuote("params"))
@@ -51,7 +51,7 @@
     pompLoad(object)
     params[par.est.idx] <- par
     if (transform)
-      tparams <- partrans(object,params,dir="forward")
+      tparams <- partrans(object,params,dir="fromEstimationScale")
     d <- dmeasure(
                   object,
                   y=object at data,



More information about the pomp-commits mailing list