[Pomp-commits] r985 - in pkg: . pomp pomp/R pomp/inst pomp/man pomp/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Jun 27 21:48:02 CEST 2014
Author: kingaa
Date: 2014-06-27 21:48:02 +0200 (Fri, 27 Jun 2014)
New Revision: 985
Modified:
pkg/Makefile
pkg/pomp/DESCRIPTION
pkg/pomp/NAMESPACE
pkg/pomp/R/generics.R
pkg/pomp/R/nlf-funcs.R
pkg/pomp/R/nlf-objfun.R
pkg/pomp/R/nlf.R
pkg/pomp/inst/NEWS
pkg/pomp/inst/NEWS.Rd
pkg/pomp/man/mif.Rd
pkg/pomp/man/nlf.Rd
pkg/pomp/tests/ou2-nlf.R
pkg/pomp/tests/ou2-nlf.Rout.save
Log:
- introduce new 'nlfd.pomp' class
- 'nlf' is now an S4 method
- improve the 'cran' build methods in the Makefile
Modified: pkg/Makefile
===================================================================
--- pkg/Makefile 2014-06-25 17:50:18 UTC (rev 984)
+++ pkg/Makefile 2014-06-27 19:48:02 UTC (rev 985)
@@ -63,9 +63,9 @@
$(TOUCH) $@
%.cransrc:
- $(RM) -r cran
mkdir -p cran
- svn export $* cran/$*
+ $(RM) -r cran/$*
+ git archive --format=tar master $* | (cd cran; tar -xf -)
$(RM) -r cran/$*/tests
$(TOUCH) $@
Modified: pkg/pomp/DESCRIPTION
===================================================================
--- pkg/pomp/DESCRIPTION 2014-06-25 17:50:18 UTC (rev 984)
+++ pkg/pomp/DESCRIPTION 2014-06-27 19:48:02 UTC (rev 985)
@@ -1,8 +1,8 @@
Package: pomp
Type: Package
Title: Statistical inference for partially observed Markov processes
-Version: 0.52-1
-Date: 2014-06-26
+Version: 0.53-1
+Date: 2014-06-27
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/NAMESPACE
===================================================================
--- pkg/pomp/NAMESPACE 2014-06-25 17:50:18 UTC (rev 984)
+++ pkg/pomp/NAMESPACE 2014-06-27 19:48:02 UTC (rev 985)
@@ -46,6 +46,7 @@
mif,mifList,
pmcmc,pmcmcList,
traj.matched.pomp,
+ nlfd.pomp,
probed.pomp,probe.matched.pomp,
spect.pomp,spect.matched.pomp,
abc,abcList,
@@ -63,7 +64,7 @@
eff.sample.size,cond.logLik,
particles,mif,continue,states,trajectory,
pred.mean,pred.var,filter.mean,conv.rec,
- bsmc,pmcmc,abc,
+ bsmc,pmcmc,abc,nlf,
traj.match.objfun,
probe.match.objfun,
spect,probe,probe.match,
@@ -89,7 +90,6 @@
bspline.basis,
periodic.bspline.basis,
compare.mif,
- nlf,
parmat,
logmeanexp,
probe.mean,
Modified: pkg/pomp/R/generics.R
===================================================================
--- pkg/pomp/R/generics.R 2014-06-25 17:50:18 UTC (rev 984)
+++ pkg/pomp/R/generics.R 2014-06-27 19:48:02 UTC (rev 985)
@@ -66,6 +66,9 @@
## particle Markov chain Monte Carlo (PMCMC)
setGeneric('pmcmc',function(object,...)standardGeneric("pmcmc"))
+## nonlinear forecasting
+setGeneric('nlf',function(object,...)standardGeneric("nlf"))
+
## iterated filtering
setGeneric('mif',function(object,...)standardGeneric("mif"))
## generate new particles
Modified: pkg/pomp/R/nlf-funcs.R
===================================================================
--- pkg/pomp/R/nlf-funcs.R 2014-06-25 17:50:18 UTC (rev 984)
+++ pkg/pomp/R/nlf-funcs.R 2014-06-27 19:48:02 UTC (rev 985)
@@ -81,7 +81,7 @@
ncol.B <- ncol(B)
Tmat <- matrix(0,nrow(A),ncol.A*ncol.B)
for (i in seq_len(ncol.A)) {
- start=(i-1)*ncol.B
+ start <- (i-1)*ncol.B
for (j in seq_len(ncol.B)) {
Tmat[,start+j] <- A[,i]*B[,j]
}
Modified: pkg/pomp/R/nlf-objfun.R
===================================================================
--- pkg/pomp/R/nlf-objfun.R 2014-06-25 17:50:18 UTC (rev 984)
+++ pkg/pomp/R/nlf-objfun.R 2014-06-27 19:48:02 UTC (rev 985)
@@ -1,6 +1,6 @@
-NLF.LQL <- function (params.fitted, object, params, par.index, transform.params = FALSE,
- times, t0, lags, period, tensor, seed = NULL, transform = identity,
- nrbf = 4, verbose = FALSE,
+NLF.LQL <- function (params.fitted, object, params, par.index, transform = FALSE,
+ times, t0, lags, period, tensor, seed = NULL,
+ transform.data = identity, nrbf = 4, verbose = FALSE,
bootstrap = FALSE, bootsamp = NULL) {
###>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
@@ -9,16 +9,14 @@
### so a large NEGATIVE value is used to flag bad parameters
###>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
- transform.params <- as.logical(transform.params)
+ transform <- as.logical(transform)
FAILED = -99999999999
params[par.index] <- params.fitted
- if (transform.params)
+ if (transform)
params <- partrans(object,params,dir="forward")
- ## Need to extract number of state variables (nvar) from pomp object
- ## Need to include simulation times in problem specification
## Evaluates the NLF objective function given a POMP object.
## Version 0.1, 3 Dec. 2007, Bruce E. Kendall & Stephen P. Ellner
## Version 0.2, May 2008, Stephen P. Ellner
@@ -31,6 +29,7 @@
)
if (inherits(y,"try-error"))
stop(sQuote("NLF.LQL")," reports: error in simulation")
+
## Test whether the model time series is valid
if (!all(is.finite(y))) return(FAILED)
@@ -38,8 +37,8 @@
dim=c(nrow(data.ts),length(times)),
dimnames=list(rownames(data.ts),NULL)
)
- model.ts[,] <- apply(y[,1,,drop=FALSE],c(2,3),transform)
- data.ts[,] <- apply(data.ts,2,transform)
+ model.ts[,] <- apply(y[,1,,drop=FALSE],c(2,3),transform.data)
+ data.ts[,] <- apply(data.ts,2,transform.data)
LQL <- try(
NLF.guts(
Modified: pkg/pomp/R/nlf.R
===================================================================
--- pkg/pomp/R/nlf.R 2014-06-25 17:50:18 UTC (rev 984)
+++ pkg/pomp/R/nlf.R 2014-06-27 19:48:02 UTC (rev 985)
@@ -1,60 +1,78 @@
-nlf <- function (object, start, est, lags,
- period = NA, tensor = FALSE,
- nconverge = 1000, nasymp = 1000,
- seed = 1066, transform = identity,
- nrbf = 4, method = "subplex",
- skip.se = FALSE, verbose = FALSE, gr = NULL,
- bootstrap = FALSE, bootsamp = NULL,
- lql.frac = 0.1, se.par.frac = 0.1,
- eval.only = FALSE, transform.params = FALSE, ...) {
+## Fit a POMP object using NLF
+## v. 0.1, 3 Dec. 2007
+## by Bruce Kendall & Steve Ellner
+##
+## v. 0.2, 30 May 2008, by Steve Ellner
+## Adds automatic Wald asymptotic standard errors and the
+## capability for moving-blocks bootstrap standard errors.
+## Quadratic regression near optimum used to select increments
+## for finite-difference approximations to gradient and Hessian
+##
+## v 1.0, 19 June 2008 by Steve Ellner and Aaron King
+## adds capacity to fit models with periodically time-varying parameters
+## of known period and improves the compatibility with the standard for pomp objects
- ## Fit a POMP object using NLF
- ## v. 0.1, 3 Dec. 2007
- ## by Bruce Kendall & Steve Ellner
- ##
- ## v. 0.2, 30 May 2008, by Steve Ellner
- ## Adds automatic Wald asymptotic standard errors and the
- ## capability for moving-blocks bootstrap standard errors.
- ## Quadratic regression near optimum used to select increments
- ## for finite-difference approximations to gradient and Hessian
- ##
- ## v 1.0, 19 June 2008 by Steve Ellner and Aaron King
- ## adds capacity to fit models with periodically time-varying parameters
- ## of known period and improves the compatibility with the standard for pomp objects
+setClass("nlfd.pomp",
+ contains="pomp",
+ slots=c(
+ transform = "logical",
+ transform.data = "function",
+ est = 'character',
+ lags="integer",
+ nconverge = 'integer',
+ nasymp = 'integer',
+ seed="integer",
+ period="numeric",
+ tensor="logical",
+ nrbf="integer",
+ method="character",
+ lql.frac="numeric",
+ se.par.frac="numeric",
+ Qhat="matrix",
+ se="numeric",
+ logql="numeric"
+ ),
+ prototype=prototype(
+ transform=FALSE,
+ transform.data=identity,
+ est=character(0),
+ lags=integer(0),
+ nconverge=0L,
+ nasymp=0L,
+ seed=0L,
+ period=as.numeric(NA),
+ tensor=FALSE,
+ nrbf=4L,
+ method=character(0),
+ lql.frac=0.1,
+ se.par.frac=0.1,
+ Qhat=matrix(NA,0,0),
+ se=numeric(0),
+ logql=as.numeric(NA)
+ )
+ )
- if (!is(object,'pomp'))
- stop("'object' must be a 'pomp' object")
-
- transform <- match.fun(transform)
-
- if (eval.only) est <- 1L
-
+nlf.internal <- function (object, start, est, lags, period, tensor,
+ nconverge, nasymp, seed, transform,
+ nrbf, method, skip.se, verbose,
+ bootstrap, bootsamp, lql.frac, se.par.frac,
+ eval.only, transform.data, ...)
+{
+
+ if (eval.only) est <- character(0)
if (missing(start)) start <- coef(object)
-
- transform.params <- as.logical(transform.params)
- if (transform.params)
+ if (transform)
params <- partrans(object,start,dir="inverse")
else
params <- start
- if (is.character(est)) {
- if (!all(est%in%names(params)))
- stop("parameters named in ",sQuote("est")," must exist in ",sQuote("start"))
- par.index <- which(names(params)%in%est)
- } else if (is.numeric(est)) {
- est <- as.integer(est)
- if (any((est<1)|(est>length(params))))
- stop("indices in ",sQuote("est")," are not appropriate")
- par.index <- est
- }
-
+ par.index <- which(names(params)%in%est)
+ if (length(est)==0) par.index <- integer(0)
guess <- params[par.index]
- lql.frac <- as.numeric(lql.frac)
if ((lql.frac<=0)||(lql.frac>=1))
stop(sQuote("lql.frac")," must be in (0,1)")
- se.par.frac <- as.numeric(se.par.frac)
if ((se.par.frac<=0)||(se.par.frac>=1))
stop(sQuote("se.par.frac")," must be in (0,1)")
@@ -79,88 +97,93 @@
object=object,
params=params,
par.index=par.index,
- transform.params=transform.params,
+ transform=transform,
times=times,
t0=t0,
lags=lags,
period=period,
tensor=tensor,
seed=seed,
- transform=transform,
+ transform.data=transform.data,
nrbf=nrbf,
verbose=verbose,
bootstrap=bootstrap,
bootsamp=bootsamp
)
- return(-val)
- }
-
- if (method == 'subplex') {
- opt <- subplex(
+ opt <- list(params=params,value=val)
+ } else {
+ if (method == 'subplex') {
+ opt <- subplex(
+ par=guess,
+ fn=nlf.objfun,
+ object=object,
+ params=params,
+ par.index=par.index,
+ transform=transform,
+ times=times,
+ t0=t0,
+ lags=lags,
+ period=period,
+ tensor=tensor,
+ seed=seed,
+ transform.data=transform.data,
+ nrbf=nrbf,
+ verbose=verbose,
+ bootstrap=bootstrap,
+ bootsamp=bootsamp,
+ control=list(...)
+ )
+ } else {
+ opt <- optim(
par=guess,
fn=nlf.objfun,
+ gr=NULL,
+ method=method,
object=object,
params=params,
par.index=par.index,
- transform.params=transform.params,
+ transform=transform,
times=times,
t0=t0,
lags=lags,
period=period,
tensor=tensor,
seed=seed,
- transform=transform,
+ transform.data=transform.data,
nrbf=nrbf,
verbose=verbose,
bootstrap=bootstrap,
bootsamp=bootsamp,
control=list(...)
- )
- } else {
- opt <- optim(
- par=guess,
- fn=nlf.objfun,
- gr=gr,
- method=method,
- object=object,
- params=params,
- par.index=par.index,
- transform.params=transform.params,
- times=times,
- t0=t0,
- lags=lags,
- period=period,
- tensor=tensor,
- seed=seed,
- transform=transform,
- nrbf=nrbf,
- verbose=verbose,
- bootstrap=bootstrap,
- bootsamp=bootsamp,
- control=list(...)
- )
+ )
+ }
+
+ params[par.index] <- opt$par
+ opt$params <- if (transform) partrans(object,params,dir="forward") else params
+
}
- opt$est <- est
- opt$value <- -opt$value
- params[par.index] <- opt$par
- opt$params <- if (transform.params) partrans(object,params,dir="forward") else params
- opt$par <- NULL
+ opt$Qhat <- matrix(NA,0,0)
+ opt$se <- numeric(0)
+
+ ## compute estimated Variance-Covariance matrix of fitted parameters
+ fitted <- params[par.index]
+ nfitted <- length(fitted)
- if (!skip.se) { ## compute estimated Variance-Covariance matrix of fitted parameters
- fitted <- params[par.index]
- nfitted <- length(fitted)
+ if (!skip.se && nfitted>0) {
Jhat <- matrix(0,nfitted,nfitted)
Ihat <- Jhat
- f0 <- NLF.LQL(fitted,
+ f0 <- NLF.LQL(
+ fitted,
object=object,
params=params,
par.index=par.index,
- transform.params=transform.params,
+ transform=transform,
times=times, t0=t0,
lags=lags, period=period, tensor=tensor, seed=seed,
- transform=transform, nrbf=4,
- verbose=FALSE)
+ transform.data=transform.data, nrbf=4,
+ verbose=FALSE
+ )
F0 <- mean(f0,na.rm=T)
npts <- length(f0)
@@ -177,33 +200,53 @@
Fvals[3] <- F0
guess <- fitted
guess[i] <- fitted[i]-sqrt(2)*h*abs(fitted[i])
- Fvals[1] <- mean(NLF.LQL(guess,object=object, params=params, par.index=par.index,
- transform.params=transform.params,
+ Fvals[1] <- mean(
+ NLF.LQL(
+ guess,object=object, params=params, par.index=par.index,
+ transform=transform,
times=times, t0=t0, lags=lags, period=period, tensor=tensor,
- seed=seed, transform=transform,
- nrbf=4, verbose=FALSE),na.rm=T)
+ seed=seed, transform.data=transform.data,nrbf=4,
+ verbose=FALSE
+ ),
+ na.rm=T
+ )
guess <- fitted
guess[i] <- fitted[i]-h*abs(fitted[i])
- Fvals[2] <- mean(NLF.LQL(guess,object=object, params=params, par.index=par.index,
- transform.params=transform.params,
+ Fvals[2] <- mean(
+ NLF.LQL(
+ guess,object=object, params=params, par.index=par.index,
+ transform=transform,
times=times, t0=t0, lags=lags, period=period, tensor=tensor,
- seed=seed, transform=transform, nrbf=4,
- verbose=FALSE),na.rm=T)
+ seed=seed, transform.data=transform.data, nrbf=4,
+ verbose=FALSE
+ ),
+ na.rm=T
+ )
guess <- fitted
guess[i] <- fitted[i]+h*abs(fitted[i])
- Fvals[4] <- mean(NLF.LQL(guess,object=object, params=params, par.index=par.index,
- transform.params=transform.params,
+ Fvals[4] <- mean(
+ NLF.LQL(
+ guess,object=object, params=params, par.index=par.index,
+ transform=transform,
times=times, t0=t0, lags=lags, period=period, tensor=tensor,
- seed=seed, transform=transform, nrbf=4,
- verbose=FALSE),na.rm=T)
+ seed=seed, transform.data=transform.data, nrbf=4,
+ verbose=FALSE
+ ),
+ na.rm=T
+ )
guess <- fitted
guess[i] <- fitted[i]+sqrt(2)*h*abs(fitted[i])
- Fvals[5] <- mean(NLF.LQL(guess,object=object, params=params, par.index=par.index,
- transform.params=transform.params,
+ Fvals[5] <- mean(
+ NLF.LQL(
+ guess,object=object, params=params, par.index=par.index,
+ transform=transform,
times=times, t0=t0, lags=lags, period=period, tensor=tensor,
- seed=seed, transform=transform, nrbf=4,
- verbose=FALSE),na.rm=T)
- FAILED = - 999999
+ seed=seed, transform.data=transform.data, nrbf=4,
+ verbose=FALSE
+ ),
+ na.rm=T
+ )
+ FAILED <- -999999
Fvals[Fvals < FAILED+10] <- NA
xvals <- c(sqrt(2),1,0,1,sqrt(2))*h*fitted[i]
c2 <- lm(Fvals~I(xvals^2))$coef[2]
@@ -217,29 +260,35 @@
for (i in seq_len(nfitted)) {
guess.up <- fitted
guess.up[i] <- guess.up[i]+eps[i]
- f.up <- NLF.LQL(guess.up,object=object, params=params, par.index=par.index,
- transform.params=transform.params,
+ f.up <- NLF.LQL(
+ guess.up,object=object, params=params, par.index=par.index,
+ transform=transform,
times=times, t0=t0, lags=lags, period=period, tensor=tensor,
- seed=seed, transform=transform, nrbf=4,
- verbose=FALSE)
+ seed=seed, transform.data=transform.data, nrbf=4,
+ verbose=FALSE
+ )
F.up <- mean(f.up,na.rm=T)
- f.up2 <- NLF.LQL(guess.up,object=object, params=params, par.index=par.index,
- transform.params=transform.params,
+ f.up2 <- NLF.LQL(
+ guess.up,object=object, params=params, par.index=par.index,
+ transform=transform,
times=times, t0=t0, lags=lags, period=period, tensor=tensor,
- seed=seed, transform=transform, nrbf=4,
- verbose=FALSE)
+ seed=seed, transform.data=transform.data, nrbf=4,
+ verbose=FALSE
+ )
if (verbose)
cat("Fitted param ", i, F.up, mean(f.up2,na.rm=T)," up in ",sQuote("nlf"),"\n")
guess.down <- fitted
guess.down[i] <- guess.down[i]-eps[i]
- f.down <- NLF.LQL(guess.down,object=object, params=params, par.index=par.index,
- transform.params=transform.params,
+ f.down <- NLF.LQL(
+ guess.down,object=object, params=params, par.index=par.index,
+ transform=transform,
times=times, t0=t0, lags=lags, period=period, tensor=tensor,
- seed=seed, transform=transform, nrbf=4,
- verbose=FALSE)
+ seed=seed, transform.data=transform.data, nrbf=4,
+ verbose=FALSE
+ )
F.down <- mean(f.down,na.rm=T)
if (verbose)
@@ -255,38 +304,58 @@
guess.uu <- fitted
guess.uu[i] <- guess.uu[i]+eps[i]
guess.uu[j] <- guess.uu[j]+eps[j]
- F.uu <- mean(NLF.LQL(guess.uu,object=object, params=params, par.index=par.index,
- transform.params=transform.params,
+ F.uu <- mean(
+ NLF.LQL(
+ guess.uu,object=object, params=params, par.index=par.index,
+ transform=transform,
times=times, t0=t0, lags=lags, period=period, tensor=tensor,
- seed=seed, transform=transform, nrbf=4,
- verbose=FALSE),na.rm=T)
+ seed=seed, transform.data=transform.data, nrbf=4,
+ verbose=FALSE
+ ),
+ na.rm=T
+ )
guess.ud <- fitted
guess.ud[i] <- guess.ud[i]+eps[i]
guess.ud[j] <- guess.ud[j]-eps[j]
- F.ud <- mean(NLF.LQL(guess.ud,object=object, params=params, par.index=par.index,
- transform.params=transform.params,
+ F.ud <- mean(
+ NLF.LQL(
+ guess.ud,object=object, params=params, par.index=par.index,
+ transform=transform,
times=times, t0=t0, lags=lags, period=period, tensor=tensor,
- seed=seed, transform=transform, nrbf=4,
- verbose=FALSE),na.rm=T)
+ seed=seed, transform.data=transform.data, nrbf=4,
+ verbose=FALSE
+ ),
+ na.rm=T
+ )
guess.du <- fitted
guess.du[i] <- guess.du[i]-eps[i]
guess.du[j] <- guess.du[j]+eps[j]
- F.du <- mean(NLF.LQL(guess.du,object=object, params=params, par.index=par.index,
- transform.params=transform.params,
+ F.du <- mean(
+ NLF.LQL(
+ guess.du,object=object, params=params, par.index=par.index,
+ transform=transform,
times=times, t0=t0, lags=lags, period=period, tensor=tensor,
- seed=seed, transform=transform, nrbf=4,
- verbose=FALSE),na.rm=T)
+ seed=seed, transform.data=transform.data, nrbf=4,
+ verbose=FALSE
+ ),
+ na.rm=T
+ )
guess.dd <- fitted
guess.dd[i] <- guess.dd[i]-eps[i]
guess.dd[j] <- guess.dd[j]-eps[j]
- F.dd <- mean(NLF.LQL(guess.dd,object=object, params=params, par.index=par.index,
- transform.params=transform.params,
+ F.dd <- mean(
+ NLF.LQL(
+ guess.dd,object=object, params=params, par.index=par.index,
+ transform=transform,
times=times, t0=t0, lags=lags, period=period, tensor=tensor,
- seed=seed, transform=transform, nrbf=4,
- verbose=FALSE),na.rm=T)
+ seed=seed, transform.data=transform.data, nrbf=4,
+ verbose=FALSE
+ ),
+ na.rm=T
+ )
dij <- (F.uu+F.dd)-(F.ud+F.du)
dij <- dij/(4*eps[i]*eps[j])
@@ -296,17 +365,175 @@
Ihat[j,i] <- Ihat[i,j]
}
}
- opt$transform.params <- transform.params
opt$Jhat <- Jhat
opt$Ihat <- Ihat
negJinv <- -solve(Jhat)
Qhat <- negJinv%*%Ihat%*%negJinv
opt$Qhat <- Qhat
- opt$se <- sqrt(diag(Qhat))/sqrt(npts)
- names(opt$se) <- names(params)[par.index]
+ opt$se <- setNames(sqrt(diag(Qhat))/sqrt(npts),names(params)[par.index])
opt$npts <- npts
}
- opt
+ new(
+ "nlfd.pomp",
+ object,
+ params=opt$params,
+ transform=transform,
+ transform.data=transform.data,
+ est=est,
+ lags=lags,
+ nconverge=nconverge,
+ nasymp=nasymp,
+ seed=seed,
+ period=period,
+ tensor=tensor,
+ nrbf=nrbf,
+ method=method,
+ lql.frac=lql.frac,
+ se.par.frac=se.par.frac,
+ Qhat=opt$Qhat,
+ se=opt$se,
+ logql=-opt$value
+ )
}
+setMethod(
+ "nlf",
+ signature=signature(object="pomp"),
+ definition=function (object,
+ start, est, lags,
+ period = NA, tensor = FALSE,
+ nconverge = 1000L, nasymp = 1000L,
+ seed = 1066L, transform.data,
+ nrbf = 4L,
+ method = c(
+ "subplex", "Nelder-Mead", "BFGS", "CG",
+ "L-BFGS-B", "SANN", "Brent"
+ ),
+ skip.se = FALSE,
+ verbose = getOption("verbose"),
+ bootstrap = FALSE, bootsamp = NULL,
+ lql.frac = 0.1, se.par.frac = 0.1,
+ eval.only = FALSE, transform.params = FALSE,
+ transform, ...)
+ {
+ transform.params <- as.logical(transform.params)
+ if (!missing(transform)) {
+ warning("argument ",sQuote("transform"),
+ " is deprecated and will change meaning in a future release.\n",
+ "Use ",sQuote("transform.data")," instead.")
+ if (missing(transform.data)) transform.data <- transform
+ }
+ if (missing(transform.data)) transform.data <- identity
+ transform.data <- match.fun(transform.data)
+ period <- as.numeric(period)
+ tensor <- as.logical(tensor)
+ skip.se <- as.logical(skip.se)
+ eval.only <- as.logical(eval.only)
+ seed <- as.integer(seed)
+ lql.frac <- as.numeric(lql.frac)
+ se.par.frac <- as.numeric(se.par.frac)
+ bootstrap <- as.logical(bootstrap)
+ bootsamp <- as.integer(bootsamp)
+ lags <- as.integer(lags)
+ nrbf <- as.integer(nrbf)
+ nasymp <- as.integer(nasymp)
+ nconverge <- as.integer(nconverge)
+
+ method <- match.arg(method)
+
+ if (eval.only) est <- character(0)
+ if (missing(start)) start <- coef(object)
+ if (!is.character(est))
+ stop(sQuote("est")," must name the parameters to be estimated")
+ if (!all(est%in%names(start)))
+ stop("parameters named in ",sQuote("est"),
+ " must exist in ",sQuote("start"))
+
+ nlf.internal(
+ object=object,
+ start=start,
+ est=est,
+ lags=lags,
+ period=period,
+ tensor=tensor,
+ nconverge=nconverge,
+ nasymp=nasymp,
+ seed=seed,
+ nrbf=nrbf,
+ method=method,
+ skip.se=skip.se,
+ verbose=verbose,
+ bootstrap=bootstrap,
+ bootsamp=bootsamp,
+ lql.frac=lql.frac,
+ se.par.frac=se.par.frac,
+ eval.only=eval.only,
+ transform=transform.params,
+ transform.data=transform.data,
+ ...
+ )
+ }
+ )
+
+setMethod(
+ "nlf",
+ signature=signature(object="nlfd.pomp"),
+ definition=function (object, start, est, lags,
+ period, tensor, nconverge, nasymp, seed,
+ transform.data, nrbf, method, lql.frac, se.par.frac,
+ transform.params, ...)
+ {
+ if (missing(start)) start <- coef(object)
+ if (missing(est)) est <- object at est
+ if (missing(lags)) lags <- object at lags
+ if (missing(period)) period <- object at period
+ if (missing(tensor)) tensor <- object at tensor
+ if (missing(nconverge)) nconverge <- object at nconverge
+ if (missing(nasymp)) nasymp <- object at nasymp
+ if (missing(seed)) seed <- object at seed
+ if (missing(transform.params)) transform.params <- object at transform
+ if (missing(transform.data)) transform.data <- object at transform.data
+ if (missing(nrbf)) nrbf <- object at nrbf
+ if (missing(method)) method <- object at method
+ if (missing(lql.frac)) lql.frac <- object at lql.frac
+ if (missing(se.par.frac)) se.par.frac <- object at se.par.frac
+
+ f <- selectMethod("nlf","pomp")
+ f(
+ object=as(object,"pomp"),
+ start=start,
+ est=est,
+ lags=lags,
+ period=period,
+ tensor=tensor,
+ nconverge=nconverge,
+ seed=seed,
+ transform.params=transform.params,
+ transform.data=transform.data,
+ nrbf=nrbf,
+ method=method,
+ lql.frac=lql.frac,
+ se.par.frac=se.par.frac,
+ ...
+ )
+ }
+ )
+
+
+
+setMethod(
+ "$",
+ signature=signature(x="nlfd.pomp"),
+ definition = function (x, name) {
+ slot(x,name)
+ }
+ )
+
+setMethod(
+ "logLik",
+ signature=signature(object="nlfd.pomp"),
+ definition = function(object, ...) {
+ object at logql
+ }
+ )
Modified: pkg/pomp/inst/NEWS
===================================================================
--- pkg/pomp/inst/NEWS 2014-06-25 17:50:18 UTC (rev 984)
+++ pkg/pomp/inst/NEWS 2014-06-27 19:48:02 UTC (rev 985)
@@ -1,5 +1,17 @@
_N_e_w_s _f_o_r _p_a_c_k_a_g_e '_p_o_m_p'
+_C_h_a_n_g_e_s _i_n '_p_o_m_p' _v_e_r_s_i_o_n _0._5_3-_1:
+
+ • ‘nlf’ now returns an S4 object of class ‘nlfd.pomp’ with a
+ ‘logLik’ method for extracting the log quasi likelihood and a
+ ‘$’ method for extracting arbitrary components.
+
+ • The ‘transform’ argument (for providing a function to
+ transform the data) has been removed in favor of
+ ‘transform.data’. The logical ‘transform.params’ argument
+ has been removed in favor of ‘transform’, as used in the
+ other inference algorithms (‘mif’, ‘probe.match’, etc.).
+
_C_h_a_n_g_e_s _i_n '_p_o_m_p' _v_e_r_s_i_o_n _0._5_2-_1:
• The new ‘mifList’ class facilitates approaches based on
Modified: pkg/pomp/inst/NEWS.Rd
===================================================================
--- pkg/pomp/inst/NEWS.Rd 2014-06-25 17:50:18 UTC (rev 984)
+++ pkg/pomp/inst/NEWS.Rd 2014-06-27 19:48:02 UTC (rev 985)
@@ -1,5 +1,11 @@
\name{NEWS}
\title{News for package `pomp'}
+\section{Changes in \pkg{pomp} version 0.53-1}{
+ \itemize{
+ \item \code{nlf} now returns an S4 object of class \code{nlfd.pomp} with a \code{logLik} method for extracting the log quasi likelihood and a \code{$} method for extracting arbitrary components.
+ \item The \code{transform} argument (for providing a function to transform the data) has been removed in favor of \code{transform.data}.
+ }
+}
\section{Changes in \pkg{pomp} version 0.52-1}{
\itemize{
\item The new \code{mifList} class facilitates approaches based on multiple \code{mif} runs.
Modified: pkg/pomp/man/mif.Rd
===================================================================
--- pkg/pomp/man/mif.Rd 2014-06-25 17:50:18 UTC (rev 984)
+++ pkg/pomp/man/mif.Rd 2014-06-27 19:48:02 UTC (rev 985)
@@ -16,7 +16,6 @@
Iterated filtering algorithms for estimating the parameters of a partially-observed Markov process.
}
\usage{
-mif(object, \dots)
\S4method{mif}{pomp}(object, Nmif = 1, start, pars, ivps = character(0),
particles, rw.sd, Np, ic.lag, var.factor,
cooling.type, cooling.fraction, cooling.factor,
Modified: pkg/pomp/man/nlf.Rd
===================================================================
--- pkg/pomp/man/nlf.Rd 2014-06-25 17:50:18 UTC (rev 984)
+++ pkg/pomp/man/nlf.Rd 2014-06-27 19:48:02 UTC (rev 985)
@@ -1,19 +1,31 @@
\name{nlf}
\alias{nlf}
+\alias{nlf,pomp-method}
+\alias{nlf-pomp}
+\alias{nlf,nlfd.pomp-method}
+\alias{nlf-nlfd.pomp}
+\alias{nlfd.pomp-class}
+\alias{logLik,nlfd.pomp-method}
+\alias{logLik-nlfd.pomp}
+\alias{$,nlfd.pomp-method}
+\alias{$-nlfd.pomp}
\title{Fit Model to Data Using Nonlinear Forecasting (NLF)}
\description{
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/pomp -r 985
More information about the pomp-commits
mailing list