[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