[Pomp-commits] r1256 - in pkg: pomp pomp/R pomp/data pomp/demo pomp/inst pomp/inst/doc pomp/inst/examples pomp/inst/include pomp/man pomp/src pomp/tests tao tao/R tao/inst tao/man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Aug 27 15:33:08 CEST 2015
Author: kingaa
Date: 2015-08-27 15:33:05 +0200 (Thu, 27 Aug 2015)
New Revision: 1256
Removed:
pkg/pomp/.Rbuildignore
pkg/pomp/.Rinstignore
pkg/pomp/DESCRIPTION
pkg/pomp/NAMESPACE
pkg/pomp/R/aaa.R
pkg/pomp/R/abc-methods.R
pkg/pomp/R/abc.R
pkg/pomp/R/authors.R
pkg/pomp/R/basic-probes.R
pkg/pomp/R/bsmc.R
pkg/pomp/R/bsmc2.R
pkg/pomp/R/bsplines.R
pkg/pomp/R/builder.R
pkg/pomp/R/csnippet.R
pkg/pomp/R/dmeasure-pomp.R
pkg/pomp/R/dprior-pomp.R
pkg/pomp/R/dprocess-pomp.R
pkg/pomp/R/eulermultinom.R
pkg/pomp/R/example.R
pkg/pomp/R/generics.R
pkg/pomp/R/init-state-pomp.R
pkg/pomp/R/load.R
pkg/pomp/R/logmeanexp.R
pkg/pomp/R/mif-methods.R
pkg/pomp/R/mif.R
pkg/pomp/R/mif2-methods.R
pkg/pomp/R/mif2.R
pkg/pomp/R/minim.R
pkg/pomp/R/nlf-funcs.R
pkg/pomp/R/nlf-guts.R
pkg/pomp/R/nlf-objfun.R
pkg/pomp/R/nlf.R
pkg/pomp/R/parmat.R
pkg/pomp/R/pfilter-methods.R
pkg/pomp/R/pfilter.R
pkg/pomp/R/plot-pomp.R
pkg/pomp/R/plugins.R
pkg/pomp/R/pmcmc-methods.R
pkg/pomp/R/pmcmc.R
pkg/pomp/R/pomp-class.R
pkg/pomp/R/pomp-fun.R
pkg/pomp/R/pomp-methods.R
pkg/pomp/R/pomp.R
pkg/pomp/R/probe-match.R
pkg/pomp/R/probe.R
pkg/pomp/R/profile-design.R
pkg/pomp/R/proposals.R
pkg/pomp/R/rmeasure-pomp.R
pkg/pomp/R/rprior-pomp.R
pkg/pomp/R/rprocess-pomp.R
pkg/pomp/R/sannbox.R
pkg/pomp/R/simulate-pomp.R
pkg/pomp/R/skeleton-pomp.R
pkg/pomp/R/slice-design.R
pkg/pomp/R/sobol.R
pkg/pomp/R/spect-match.R
pkg/pomp/R/spect.R
pkg/pomp/R/traj-match.R
pkg/pomp/R/trajectory-pomp.R
pkg/pomp/data/LondonYorke.rda
pkg/pomp/data/ewcitmeas.rda
pkg/pomp/data/ewmeas.rda
pkg/pomp/demo/00Index
pkg/pomp/demo/gompertz.R
pkg/pomp/demo/logistic.R
pkg/pomp/demo/rw2.R
pkg/pomp/demo/sir.R
pkg/pomp/inst/CITATION
pkg/pomp/inst/GPL
pkg/pomp/inst/NEWS
pkg/pomp/inst/NEWS.Rd
pkg/pomp/inst/TODO.md
pkg/pomp/inst/doc/index.html
pkg/pomp/inst/examples/bbs.R
pkg/pomp/inst/examples/blowflies.R
pkg/pomp/inst/examples/dacca.R
pkg/pomp/inst/examples/euler.sir.R
pkg/pomp/inst/examples/gillespie.sir.R
pkg/pomp/inst/examples/gompertz.R
pkg/pomp/inst/examples/ou2.R
pkg/pomp/inst/examples/ricker.R
pkg/pomp/inst/examples/rw2.R
pkg/pomp/inst/include/pomp.h
pkg/pomp/man/abc.Rd
pkg/pomp/man/basic-probes.Rd
pkg/pomp/man/blowflies.Rd
pkg/pomp/man/bsmc.Rd
pkg/pomp/man/bsplines.Rd
pkg/pomp/man/builder.Rd
pkg/pomp/man/csnippet.Rd
pkg/pomp/man/dacca.Rd
pkg/pomp/man/design.Rd
pkg/pomp/man/eulermultinom.Rd
pkg/pomp/man/example.Rd
pkg/pomp/man/gompertz.Rd
pkg/pomp/man/logmeanexp.Rd
pkg/pomp/man/lowlevel.Rd
pkg/pomp/man/measles.Rd
pkg/pomp/man/mif.Rd
pkg/pomp/man/mif2.Rd
pkg/pomp/man/nlf.Rd
pkg/pomp/man/ou2.Rd
pkg/pomp/man/package.Rd
pkg/pomp/man/parmat.Rd
pkg/pomp/man/particles-mif.Rd
pkg/pomp/man/pfilter.Rd
pkg/pomp/man/plugins.Rd
pkg/pomp/man/pmcmc.Rd
pkg/pomp/man/pomp-fun.Rd
pkg/pomp/man/pomp-methods.Rd
pkg/pomp/man/pomp.Rd
pkg/pomp/man/probe.Rd
pkg/pomp/man/proposals.Rd
pkg/pomp/man/ricker.Rd
pkg/pomp/man/rw2.Rd
pkg/pomp/man/sannbox.Rd
pkg/pomp/man/simulate-pomp.Rd
pkg/pomp/man/sir.Rd
pkg/pomp/man/spect.Rd
pkg/pomp/man/traj-match.Rd
pkg/pomp/src/Makevars
pkg/pomp/src/R_init_pomp.c
pkg/pomp/src/SSA.f90
pkg/pomp/src/SSA_wrapper.c
pkg/pomp/src/blowfly.c
pkg/pomp/src/bspline.c
pkg/pomp/src/cholmodel.c
pkg/pomp/src/dmeasure.c
pkg/pomp/src/dprior.c
pkg/pomp/src/dprocess.c
pkg/pomp/src/dsobol.c
pkg/pomp/src/euler.c
pkg/pomp/src/eulermultinom.c
pkg/pomp/src/gompertz.c
pkg/pomp/src/initstate.c
pkg/pomp/src/lookup_table.c
pkg/pomp/src/lpa.c
pkg/pomp/src/mif.c
pkg/pomp/src/mif2.c
pkg/pomp/src/ou2.c
pkg/pomp/src/partrans.c
pkg/pomp/src/pfilter.c
pkg/pomp/src/pomp.h
pkg/pomp/src/pomp_fun.c
pkg/pomp/src/pomp_internal.h
pkg/pomp/src/pomp_mat.h
pkg/pomp/src/probe.c
pkg/pomp/src/probe_acf.c
pkg/pomp/src/probe_marginal.c
pkg/pomp/src/probe_nlar.c
pkg/pomp/src/ricker.c
pkg/pomp/src/rmeasure.c
pkg/pomp/src/rprior.c
pkg/pomp/src/rprocess.c
pkg/pomp/src/simulate.c
pkg/pomp/src/sir.c
pkg/pomp/src/skeleton.c
pkg/pomp/src/sobol.f
pkg/pomp/src/synth_lik.c
pkg/pomp/src/trajectory.c
pkg/pomp/src/tsir.c
pkg/pomp/src/userdata.c
pkg/pomp/tests/bbs-trajmatch.R
pkg/pomp/tests/bbs-trajmatch.Rout.save
pkg/pomp/tests/bbs.R
pkg/pomp/tests/bbs.Rout.save
pkg/pomp/tests/blowflies.R
pkg/pomp/tests/blowflies.Rout.save
pkg/pomp/tests/dacca.R
pkg/pomp/tests/dacca.Rout.save
pkg/pomp/tests/demos.R
pkg/pomp/tests/dimchecks.R
pkg/pomp/tests/dimchecks.Rout.save
pkg/pomp/tests/fhn.R
pkg/pomp/tests/fhn.Rout.save
pkg/pomp/tests/filtfail.R
pkg/pomp/tests/filtfail.Rout.save
pkg/pomp/tests/getting_started.R
pkg/pomp/tests/getting_started.Rout.save
pkg/pomp/tests/gillespie.R
pkg/pomp/tests/gillespie.Rout.save
pkg/pomp/tests/gompertz.R
pkg/pomp/tests/gompertz.Rout.save
pkg/pomp/tests/logistic.R
pkg/pomp/tests/logistic.Rout.save
pkg/pomp/tests/ou2-abc.R
pkg/pomp/tests/ou2-abc.Rout.save
pkg/pomp/tests/ou2-bsmc.R
pkg/pomp/tests/ou2-bsmc.Rout.save
pkg/pomp/tests/ou2-bsmc2.R
pkg/pomp/tests/ou2-bsmc2.Rout.save
pkg/pomp/tests/ou2-forecast.R
pkg/pomp/tests/ou2-forecast.Rout.save
pkg/pomp/tests/ou2-kalman.R
pkg/pomp/tests/ou2-kalman.Rout.save
pkg/pomp/tests/ou2-mif-fp.R
pkg/pomp/tests/ou2-mif-fp.Rout.save
pkg/pomp/tests/ou2-mif.R
pkg/pomp/tests/ou2-mif.Rout.save
pkg/pomp/tests/ou2-mif2.R
pkg/pomp/tests/ou2-mif2.Rout.save
pkg/pomp/tests/ou2-nlf.R
pkg/pomp/tests/ou2-nlf.Rout.save
pkg/pomp/tests/ou2-pmcmc.R
pkg/pomp/tests/ou2-pmcmc.Rout.save
pkg/pomp/tests/ou2-probe.R
pkg/pomp/tests/ou2-probe.Rout.save
pkg/pomp/tests/ou2-procmeas.R
pkg/pomp/tests/ou2-procmeas.Rout.save
pkg/pomp/tests/ou2-simulate.R
pkg/pomp/tests/ou2-simulate.Rout.save
pkg/pomp/tests/ou2-spect.R
pkg/pomp/tests/ou2-spect.Rout.save
pkg/pomp/tests/ou2-trajmatch.R
pkg/pomp/tests/ou2-trajmatch.Rout.save
pkg/pomp/tests/partrans.R
pkg/pomp/tests/partrans.Rout.save
pkg/pomp/tests/pfilter.R
pkg/pomp/tests/pfilter.Rout.save
pkg/pomp/tests/pomppomp.R
pkg/pomp/tests/pomppomp.Rout.save
pkg/pomp/tests/prior.R
pkg/pomp/tests/prior.Rout.save
pkg/pomp/tests/ricker-bsmc.R
pkg/pomp/tests/ricker-bsmc.Rout.save
pkg/pomp/tests/ricker-probe.R
pkg/pomp/tests/ricker-probe.Rout.save
pkg/pomp/tests/ricker-spect.R
pkg/pomp/tests/ricker-spect.Rout.save
pkg/pomp/tests/ricker.R
pkg/pomp/tests/ricker.Rout.save
pkg/pomp/tests/rw2.R
pkg/pomp/tests/rw2.Rout.save
pkg/pomp/tests/sir.R
pkg/pomp/tests/sir.Rout.save
pkg/pomp/tests/skeleton.R
pkg/pomp/tests/skeleton.Rout.save
pkg/pomp/tests/steps.R
pkg/pomp/tests/steps.Rout.save
pkg/pomp/tests/synlik.R
pkg/pomp/tests/synlik.Rout.save
pkg/tao/DESCRIPTION
pkg/tao/NAMESPACE
pkg/tao/R/do.nothing.R
pkg/tao/R/do.nothing.else.R
pkg/tao/inst/GPL
pkg/tao/man/do.nothing.Rd
pkg/tao/man/tao.Rd
Log:
- everything is now on github
Deleted: pkg/pomp/.Rbuildignore
===================================================================
--- pkg/pomp/.Rbuildignore 2015-07-07 13:21:39 UTC (rev 1255)
+++ pkg/pomp/.Rbuildignore 2015-08-27 13:33:05 UTC (rev 1256)
@@ -1,4 +0,0 @@
-inst/doc/Makefile
-inst/doc/(.+?)\.bst$
-inst/doc/(.+?)\.R$
-inst/doc/(.+?)\.png$
Deleted: pkg/pomp/.Rinstignore
===================================================================
--- pkg/pomp/.Rinstignore 2015-07-07 13:21:39 UTC (rev 1255)
+++ pkg/pomp/.Rinstignore 2015-08-27 13:33:05 UTC (rev 1256)
@@ -1,3 +0,0 @@
-inst/doc/Makefile
-inst/doc/fullnat.bst
-inst/doc/(.+?)\.rda$
Deleted: pkg/pomp/DESCRIPTION
===================================================================
--- pkg/pomp/DESCRIPTION 2015-07-07 13:21:39 UTC (rev 1255)
+++ pkg/pomp/DESCRIPTION 2015-08-27 13:33:05 UTC (rev 1256)
@@ -1,43 +0,0 @@
-Package: pomp
-Type: Package
-Title: Statistical Inference for Partially Observed Markov Processes
-Version: 0.69-5
-Date: 2015-07-06
-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")),
- person(given=c("Carles"),family="Breto",role=c("aut")),
- person(given=c("Stephen","P."),family="Ellner",role=c("ctb")),
- person(given=c("Matthew","J."),family="Ferrari",role=c("ctb")),
- person(given=c("Bruce","E."),family="Kendall",role=c("ctb")),
- person(given=c("Michael"),family="Lavine",role=c("ctb")),
- person(given="Dao",family="Nguyen",role=c("ctb")),
- person(given=c("Daniel","C."),family="Reuman",role=c("ctb")),
- person(given=c("Helen"),family="Wearing",role=c("ctb")),
- person(given=c("Simon","N."),family="Wood",role=c("ctb"))
- )
-URL: http://pomp.r-forge.r-project.org
-Description: Tools for working with partially observed Markov processes (POMPs, AKA stochastic dynamical systems, state-space models). 'pomp' provides facilities for implementing POMP models, simulating them, and fitting them to time series data by a variety of frequentist and Bayesian methods. It is also a platform for the implementation of new inference methods.
-Depends: R(>= 3.0.0), methods
-Imports: stats, graphics, mvtnorm, deSolve, coda, subplex, nloptr
-SystemRequirements: for Windows users, Rtools (see http://cran.r-project.org/bin/windows/Rtools/)
-License: GPL(>= 2)
-LazyData: true
-MailingList: Subscribe to pomp-announce at r-forge.r-project.org for announcements by going to http://lists.r-forge.r-project.org/mailman/listinfo/pomp-announce.
-Collate: aaa.R authors.R generics.R eulermultinom.R
- csnippet.R pomp-fun.R plugins.R builder.R
- parmat.R logmeanexp.R slice-design.R
- profile-design.R sobol.R bsplines.R sannbox.R
- pomp-class.R load.R pomp.R pomp-methods.R
- rmeasure-pomp.R rprocess-pomp.R init-state-pomp.R
- dmeasure-pomp.R dprocess-pomp.R skeleton-pomp.R
- dprior-pomp.R rprior-pomp.R
- simulate-pomp.R trajectory-pomp.R plot-pomp.R
- pfilter.R pfilter-methods.R minim.R traj-match.R
- bsmc.R bsmc2.R
- mif.R mif-methods.R mif2.R mif2-methods.R
- proposals.R pmcmc.R pmcmc-methods.R
- nlf-funcs.R nlf-guts.R nlf-objfun.R nlf.R
- probe.R probe-match.R basic-probes.R spect.R spect-match.R
- abc.R abc-methods.R
- example.R
Deleted: pkg/pomp/NAMESPACE
===================================================================
--- pkg/pomp/NAMESPACE 2015-07-07 13:21:39 UTC (rev 1255)
+++ pkg/pomp/NAMESPACE 2015-08-27 13:33:05 UTC (rev 1256)
@@ -1,123 +0,0 @@
-useDynLib(
- pomp,
- bspline_basis,
- periodic_bspline_basis,
- bspline_basis_function,
- systematic_resampling,
- euler_model_simulator,
- euler_model_density,
- lookup_in_table,
- load_stack_incr,load_stack_decr,
- SSA_simulator,
- R_Euler_Multinom,D_Euler_Multinom,R_GammaWN,
- mif_update,
- mif2_computations,
- pfilter_computations,
- simulation_computations,
- iterate_map,traj_transp_and_copy,
- apply_probe_data,apply_probe_sim,
- probe_marginal_setup,probe_marginal_solve,
- probe_acf,probe_ccf,
- probe_nlar,
- synth_loglik,
- pomp_desolve_setup,pomp_desolve_takedown,
- pomp_vf_eval,
- do_partrans,
- do_rprocess,
- do_dprocess,
- do_rmeasure,
- do_dmeasure,
- do_rprior,
- do_dprior,
- do_skeleton,
- do_init_state
- )
-
-import(methods)
-importFrom(graphics,plot,par,abline,pairs,matplot,box,axis,mtext,
- points,polygon,lines,plot.default,legend,hist,rect,text)
-importFrom(grDevices,rgb,dev.interactive)
-importFrom(stats,simulate,time,coef,logLik,window,
- dnorm,runif,sd,cov,cor,median,density,
- spec.pgram,rnorm,weighted.mean,optim,
- .lm.fit,setNames,kernel,quantile)
-importFrom(mvtnorm,dmvnorm,rmvnorm)
-importFrom(subplex,subplex)
-importFrom(deSolve,ode)
-importFrom(nloptr,nloptr)
-importFrom(coda,mcmc,mcmc.list)
-
-exportClasses(
- pomp,
- pfilterd.pomp,
- mif,mifList,
- mif2d.pomp,mif2List,
- pmcmc,pmcmcList,
- traj.matched.pomp,
- nlfd.pomp,
- probed.pomp,probe.matched.pomp,
- spect.pomp,spect.matched.pomp,
- abc,abcList,
- Csnippet
- )
-
-exportMethods(
- pomp,
- plot,show,print,coerce,summary,logLik,window,"$",
- pompLoad,pompUnload,
- dprocess,rprocess,rmeasure,dmeasure,init.state,skeleton,
- dprior,rprior,
- data.array,obs,partrans,coef,"coef<-",
- time,"time<-",timezero,"timezero<-",
- simulate,pfilter,
- eff.sample.size,cond.logLik,
- states,trajectory,
- particles,mif,mif2,continue,
- pred.mean,pred.var,filter.mean,conv.rec,
- values,
- bsmc2,bsmc,pmcmc,abc,nlf,
- traj.match.objfun,
- probe.match.objfun,
- spect,probe,probe.match,
- traj.match
- )
-
-S3method(as.data.frame,pomp)
-S3method(as.data.frame,pfilterd.pomp)
-S3method(as.data.frame,probed.pomp)
-
-export(
- Csnippet,
- reulermultinom,
- deulermultinom,
- rgammawn,
- euler.sim,
- discrete.time.sim,
- onestep.sim,
- onestep.dens,
- gillespie.sim,
- mvn.diag.rw,mvn.rw,
- rw.sd,
- sobol,
- sobolDesign,
- sliceDesign,
- profileDesign,
- bspline.basis,
- periodic.bspline.basis,
- parmat,
- logmeanexp,
- probe.mean,
- probe.median,
- probe.var,
- probe.sd,
- probe.period,
- probe.quantile,
- probe.acf,
- probe.ccf,
- probe.nlar,
- probe.marginal,
- sannbox,
- spect.match,
- pompBuilder,
- pompExample
- )
Deleted: pkg/pomp/R/aaa.R
===================================================================
--- pkg/pomp/R/aaa.R 2015-07-07 13:21:39 UTC (rev 1255)
+++ pkg/pomp/R/aaa.R 2015-08-27 13:33:05 UTC (rev 1256)
@@ -1,12 +0,0 @@
-.onAttach <- function (...) {
- exampleDir <- getOption("pomp.examples")
- pompExampleDir <- system.file("examples",package="pomp")
- options(pomp.examples=c(exampleDir,pompExampleDir,recursive=TRUE))
-}
-
-.onDetach <- function (...) {
- exampleDir <- getOption("pomp.examples")
- pompExampleDir <- system.file("examples",package="pomp")
- exampleDir <- exampleDir[exampleDir!=pompExampleDir]
- options(pomp.examples=exampleDir)
-}
Deleted: pkg/pomp/R/abc-methods.R
===================================================================
--- pkg/pomp/R/abc-methods.R 2015-07-07 13:21:39 UTC (rev 1255)
+++ pkg/pomp/R/abc-methods.R 2015-08-27 13:33:05 UTC (rev 1256)
@@ -1,182 +0,0 @@
-## this file contains short definitions of methods for the 'abc' class
-
-## abcList class
-setClass(
- 'abcList',
- contains='list',
- validity=function (object) {
- if (!all(sapply(object,is,'abc'))) {
- retval <- paste0(
- "error in ",sQuote("c"),
- ": dissimilar objects cannot be combined"
- )
- return(retval)
- }
- d <- sapply(object,function(x)dim(x at conv.rec))
- if (!all(apply(d,1,diff)==0)) {
- retval <- paste0(
- "error in ",sQuote("c"),
- ": to be combined, ",sQuote("abc"),
- " objects must have chains of equal length"
- )
- return(retval)
- }
- TRUE
- }
- )
-
-setMethod(
- 'c',
- signature=signature(x='abc'),
- definition=function (x, ...) {
- y <- list(...)
- if (length(y)==0) {
- new("abcList",list(x))
- } else {
- p <- sapply(y,is,'abc')
- pl <- sapply(y,is,'abcList')
- if (!all(p||pl))
- stop("cannot mix ",sQuote("abc"),
- " and non-",sQuote("abc")," objects")
- y[p] <- lapply(y[p],list)
- y[pl] <- lapply(y[pl],as,"list")
- new("abcList",c(list(x),y,recursive=TRUE))
- }
- }
- )
-
-setMethod(
- 'c',
- signature=signature(x='abcList'),
- definition=function (x, ...) {
- y <- list(...)
- if (length(y)==0) {
- x
- } else {
- p <- sapply(y,is,'abc')
- pl <- sapply(y,is,'abcList')
- if (!all(p||pl))
- stop("cannot mix ",sQuote("abc"),
- " and non-",sQuote("abc")," objects")
- y[p] <- lapply(y[p],list)
- y[pl] <- lapply(y[pl],as,"list")
- new("abcList",c(as(x,"list"),y,recursive=TRUE))
- }
- }
- )
-
-setMethod(
- "[",
- signature=signature(x="abcList"),
- definition=function(x, i, ...) {
- new('abcList',as(x,"list")[i])
- }
- )
-
-## extract the convergence record as an 'mcmc' object
-setMethod(
- 'conv.rec',
- 'abc',
- function (object, pars, ...) {
- if (missing(pars)) pars <- colnames(object at conv.rec)
- coda::mcmc(object at conv.rec[,pars,drop=FALSE])
- }
- )
-
-## extract the convergence record as an 'mcmc.list' object
-setMethod(
- 'conv.rec',
- signature=signature(object='abcList'),
- definition=function (object, ...) {
- f <- selectMethod("conv.rec","abc")
- coda::mcmc.list(lapply(object,f,...))
- }
- )
-
-## plot abc object
-setMethod(
- "plot",
- "abc",
- function (x, y, pars, scatter = FALSE, ...) {
- if (!missing(y)) {
- y <- substitute(y)
- warning(sQuote(y)," is ignored")
- }
- abc.diagnostics(c(x),pars=pars,scatter=scatter,...)
- }
- )
-
-setMethod(
- "plot",
- signature=signature(x='abcList'),
- definition=function (x, y, ...) {
- if (!missing(y)) {
- y <- substitute(y)
- warning(sQuote(y)," is ignored")
- }
- abc.diagnostics(x,...)
- }
- )
-
-abc.diagnostics <- function (z, pars, scatter = FALSE, ...) {
- if (missing(pars))
- pars <- unique(do.call(c,lapply(z,slot,'pars')))
-
- if (scatter) {
-
- x <- lapply(z,function(x)as.matrix(conv.rec(x,pars)))
- x <- lapply(seq_along(x),function(n)cbind(x[[n]],.num=n))
- x <- do.call(rbind,x)
- if (ncol(x)<3) {
- stop("can't make a scatterplot with only one variable")
- } else {
- pairs(x[,pars],col=x[,'.num'],...)
- }
-
- } else {
-
- mar.multi <- c(0,5.1,0,2.1)
- oma.multi <- c(6,0,5,0)
- xx <- z[[1]]
- estnames <- pars
- ## plot abc convergence diagnostics
- other.diagnostics <- c()
- plotnames <- c(other.diagnostics,estnames)
- nplots <- length(plotnames)
- n.per.page <- min(nplots,10)
- nc <- if (n.per.page<=4) 1 else 2
- nr <- ceiling(n.per.page/nc)
- oldpar <- par(mar=mar.multi,oma=oma.multi,mfcol=c(nr,nc))
- on.exit(par(oldpar))
- low <- 1
- hi <- 0
- iteration <- seq(0,xx at Nabc)
- while (hi<nplots) {
- hi <- min(low+n.per.page-1,nplots)
- for (i in seq(from=low,to=hi,by=1)) {
- n <- i-low+1
- dat <- sapply(z,conv.rec,pars=plotnames[i])
- matplot(
- y=dat,
- x=iteration,
- axes = FALSE,
- xlab = "",
- ylab = "",
- type = "l"
- )
- box()
- y.side <- 2
- axis(y.side,xpd=NA)
- mtext(plotnames[i],y.side,line=3)
- do.xax <- (n%%nr==0||n==n.per.page)
- if (do.xax) axis(1,xpd=NA)
- if (do.xax) mtext("ABC iteration",side=1,line=3)
- }
- low <- hi+1
- mtext("ABC convergence diagnostics",3,line=2,outer=TRUE)
- }
-
- }
- invisible(NULL)
-}
-
Deleted: pkg/pomp/R/abc.R
===================================================================
--- pkg/pomp/R/abc.R 2015-07-07 13:21:39 UTC (rev 1255)
+++ pkg/pomp/R/abc.R 2015-08-27 13:33:05 UTC (rev 1256)
@@ -1,289 +0,0 @@
-## define the abc class
-setClass(
- 'abc',
- contains='pomp',
- slots=c(
- pars = 'character',
- Nabc = 'integer',
- probes='list',
- scale = 'numeric',
- epsilon = 'numeric',
- proposal = 'function',
- conv.rec = 'matrix'
- ),
- prototype=prototype(
- pars = character(0),
- Nabc = 0L,
- probes = list(),
- scale = numeric(0),
- epsilon = 1.0,
- proposal = function (...) stop("proposal not specified"),
- conv.rec=array(dim=c(0,0))
- )
- )
-
-abc.internal <- function (object, Nabc,
- start, proposal, probes,
- epsilon, scale,
- verbose,
- .ndone = 0L,
- .getnativesymbolinfo = TRUE,
- ...) {
-
- object <- as(object,'pomp')
- gnsi <- as.logical(.getnativesymbolinfo)
- Nabc <- as.integer(Nabc)
- epsilon <- as.numeric(epsilon)
- epssq <- epsilon*epsilon
-
- pompLoad(object)
-
- if (length(start)==0)
- stop(
- "abc error: ",sQuote("start")," must be specified if ",
- sQuote("coef(object)")," is NULL",
- call.=FALSE
- )
-
- start.names <- names(start)
- if (is.null(start.names))
- stop("abc error: ",sQuote("start")," must be a named vector",call.=FALSE)
-
- if (!is.function(proposal))
- stop(sQuote("proposal")," must be a function")
-
- ## test proposal distribution
- theta <- try(proposal(start))
- if (inherits(theta,"try-error"))
- stop("abc error: error in proposal function",call.=FALSE)
- if (is.null(names(theta)) || !is.numeric(theta))
- stop("abc error: ",sQuote("proposal")," must return a named numeric vector",call.=FALSE)
-
- if (!is.list(probes)) probes <- list(probes)
- if (!all(sapply(probes,is.function)))
- stop(sQuote("probes")," must be a function or a list of functions")
- if (!all(sapply(probes,function(f)length(formals(f))==1)))
- stop("each probe must be a function of a single argument")
-
- if (verbose) {
- cat("performing",Nabc,"ABC iteration(s)\n")
- }
-
- theta <- start
- log.prior <- dprior(object,params=theta,log=TRUE,.getnativesymbolinfo=gnsi)
- if (!is.finite(log.prior))
- stop("inadmissible value of ",sQuote("dprior"),
- " at parameters ",sQuote("start"))
- ## we suppose that theta is a "match",
- ## which does the right thing for continue() and
- ## should have negligible effect unless doing many short calls to continue()
-
- conv.rec <- matrix(
- data=NA,
- nrow=Nabc+1,
- ncol=length(theta),
- dimnames=list(
- iteration=seq(from=0,to=Nabc,by=1),
- variable=names(theta)
- )
- )
-
- ## apply probes to data
- datval <- try(.Call(apply_probe_data,object,probes),silent=FALSE)
- if (inherits(datval,'try-error'))
- stop("abc error: error in ",sQuote("apply_probe_data"),call.=FALSE)
-
- conv.rec[1,names(theta)] <- theta
-
- for (n in seq_len(Nabc)) { # main loop
-
- theta.prop <- proposal(theta)
- log.prior.prop <- dprior(object,params=theta.prop,log=TRUE)
-
- if (is.finite(log.prior.prop) &&
- runif(1) < exp(log.prior.prop-log.prior)) {
-
- ## compute the probes for the proposed new parameter values
-
- simval <- try(
- .Call(
- apply_probe_sim,
- object=object,
- nsim=1,
- params=theta.prop,
- seed=NULL,
- probes=probes,
- datval=datval
- ),
- silent=FALSE
- )
-
- if (inherits(simval,'try-error'))
- stop("abc error: error in ",sQuote("apply_probe_sim"),call.=FALSE)
-
- ## ABC update rule
- distance <- sum(((datval-simval)/scale)^2)
- if( (is.finite(distance)) && (distance<epssq) ){
- theta <- theta.prop
- log.prior <- log.prior.prop
- }
-
- }
-
- ## store a record of this iteration
- conv.rec[n+1,names(theta)] <- theta
- if (verbose && (n%%5==0))
- cat("ABC iteration ",n," of ",Nabc," completed\n")
-
- }
-
- pars <- apply(conv.rec,2,function(x)diff(range(x))>0)
- pars <- names(pars[pars])
-
- pompUnload(object)
-
- new(
- 'abc',
- object,
- params=theta,
- pars=pars,
- Nabc=Nabc,
- probes=probes,
- scale=scale,
- epsilon=epsilon,
- proposal=proposal,
- conv.rec=conv.rec
- )
-
-}
-
-setMethod(
- "abc",
- signature=signature(object="pomp"),
- function (object, Nabc = 1,
- start, proposal, pars, rw.sd,
- probes, scale, epsilon,
- verbose = getOption("verbose"),
- ...) {
-
- if (missing(start))
- start <- coef(object)
-
- if (missing(proposal)) proposal <- NULL
-
- if (!missing(rw.sd)) {
- warning("abc warning: ",sQuote("rw.sd")," is a deprecated argument: ",
- "Use ",sQuote("proposal")," instead.",call.=FALSE)
- if (is.null(proposal)) {
- proposal <- mvn.diag.rw(rw.sd=rw.sd)
- } else {
- warning("abc warning: since ",sQuote("proposal"),
- " has been specified, ",sQuote("rw.sd")," is ignored.")
- }
- }
-
- if (is.null(proposal))
- stop("abc error: ",sQuote("proposal")," must be specified",call.=FALSE)
-
- if (!missing(pars))
- warning("abc warning: ",sQuote("pars")," is a deprecated argument and will be ignored.",call.=FALSE)
-
- if (missing(probes))
- stop("abc error: ",sQuote("probes")," must be specified",
- call.=FALSE)
-
- if (missing(scale))
- stop("abc error: ",sQuote("scale")," must be specified",
- call.=FALSE)
-
- if (missing(epsilon))
- stop("abc error: abc match criterion, ",sQuote("epsilon"),
- ", must be specified",call.=FALSE)
-
- abc.internal(
- object=object,
- Nabc=Nabc,
- start=start,
- proposal=proposal,
- probes=probes,
- scale=scale,
- epsilon=epsilon,
- verbose=verbose
- )
- }
- )
-
-setMethod(
- "abc",
- signature=signature(object="probed.pomp"),
- function (object, probes,
- verbose = getOption("verbose"),
- ...) {
-
- if (missing(probes)) probes <- object at probes
- f <- selectMethod("abc","pomp")
- f(
- object=object,
- probes=probes,
- ...
- )
- }
- )
-
-setMethod(
- "abc",
- signature=signature(object="abc"),
- function (object, Nabc,
- start, proposal,
- probes, scale, epsilon,
- verbose = getOption("verbose"),
- ...) {
-
- if (missing(Nabc)) Nabc <- object at Nabc
- if (missing(start)) start <- coef(object)
- if (missing(proposal)) proposal <- object at proposal
- if (missing(probes)) probes <- object at probes
- if (missing(scale)) scale <- object at scale
- if (missing(epsilon)) epsilon <- object at epsilon
-
- f <- selectMethod("abc","pomp")
-
- f(
- object=object,
- Nabc=Nabc,
- start=start,
- proposal=proposal,
- probes=probes,
- scale=scale,
- epsilon=epsilon,
- verbose=verbose,
- ...
- )
- }
- )
-
-setMethod(
- 'continue',
- signature=signature(object='abc'),
- function (object, Nabc = 1, ...) {
-
- ndone <- object at Nabc
- f <- selectMethod("abc","abc")
-
- obj <- f(
- object=object,
- Nabc=Nabc,
- .ndone=ndone,
- ...
- )
-
- obj at conv.rec <- rbind(
- object at conv.rec[,colnames(obj at conv.rec)],
- obj at conv.rec[-1,]
- )
- names(dimnames(obj at conv.rec)) <- c("iteration","variable")
- obj at Nabc <- as.integer(ndone+Nabc)
-
- obj
- }
- )
Deleted: pkg/pomp/R/authors.R
===================================================================
--- pkg/pomp/R/authors.R 2015-07-07 13:21:39 UTC (rev 1255)
+++ pkg/pomp/R/authors.R 2015-08-27 13:33:05 UTC (rev 1256)
@@ -1,12 +0,0 @@
-list(
- aak=person(given=c("Aaron","A."),family="King",role=c("aut","cre"),email="kingaa at umich.edu"),
- eli=person(given=c("Edward","L."),family="Ionides",role=c("ctb")),
- cb=person(given=c("Carles"),family="Breto",role=c("ctb")),
- spe=person(given=c("Stephen","P."),family="Ellner",role=c("ctb")),
- bek=person(given=c("Bruce","E."),family="Kendall",role=c("ctb")),
- mf=person(given=c("Matthew","J."),family="Ferrari",role=c("ctb")),
- ml=person(given=c("Michael"),family="Lavine",role=c("ctb")),
- dcr=person(given=c("Daniel","C."),family="Reuman",role=c("ctb")),
- hw=person(given=c("Helen"),family="Wearing",role=c("ctb")),
- snw=person(given=c("Simon","N."),family="Wood",role=c("ctb"))
- ) -> author.list
Deleted: pkg/pomp/R/basic-probes.R
===================================================================
--- pkg/pomp/R/basic-probes.R 2015-07-07 13:21:39 UTC (rev 1255)
+++ pkg/pomp/R/basic-probes.R 2015-08-27 13:33:05 UTC (rev 1256)
@@ -1,176 +0,0 @@
-probe.mean <- function (var, trim = 0, transform = identity, na.rm = TRUE) {
- if (length(var)>1) stop(sQuote("probe.mean")," is a univariate probe")
- transform <- match.fun(transform)
- function(y) mean(x=transform(y[var,]),trim=trim,na.rm=na.rm)
-}
-
-probe.median <- function (var, na.rm = TRUE) {
- if (length(var)>1) stop(sQuote("probe.median")," is a univariate probe")
- function(y) median(x=as.numeric(y[var,]),na.rm=na.rm)
-}
-
-probe.var <- function (var, transform = identity, na.rm = TRUE) {
- if (length(var)>1) stop(sQuote("probe.var")," is a univariate probe")
- transform <- match.fun(transform)
- function(y) var(x=transform(y[var,]),na.rm=na.rm)
-}
-
-probe.sd <- function (var, transform = identity, na.rm = TRUE) {
- if (length(var)>1) stop(sQuote("probe.sd")," is a univariate probe")
- transform <- match.fun(transform)
- function(y) sd(x=transform(y[var,]),na.rm=na.rm)
-}
-
-probe.period <- function (var, kernel.width, transform = identity) {
- if (length(var)>1) stop(sQuote("probe.period")," is a univariate probe")
- transform <- match.fun(transform)
- function (y) {
- zz <- spec.pgram(
- x=transform(y[var,]),
- kernel=kernel("modified.daniell",m=kernel.width),
- taper=0,
- fast=FALSE,
- pad=0,
- detrend=FALSE,
- plot=FALSE
- )
- 1/zz$freq[which.max(zz$spec)]
- }
-}
-
-probe.quantile <- function (var, prob, transform = identity) {
- if (length(var)>1) stop(sQuote("probe.quantile")," is a univariate probe")
- transform <- match.fun(transform)
- function (y) quantile(transform(y[var,]),probs=prob)
-}
-
-probe.cov <- function (
- vars,
- lag,
- method = c("pearson", "kendall", "spearman"),
- transform = identity
- ) {
- method <- match.arg(method)
- lag <- as.integer(lag)
- transform <- match.fun(transform)
- var1 <- vars[1L]
- if (length(vars)>1)
- var2 <- vars[2L]
- else
- var2 <- var1
- function (y) {
- if (lag>=0) {
- val <- cov(
- x=transform(y[var1,seq(from=1+lag,to=ncol(y),by=1)]),
- y=transform(y[var2,seq(from=1,to=ncol(y)-lag,by=1)]),
- method=method
- )
- } else {
- val <- cov(
- x=transform(y[var1,seq(from=1,to=ncol(y)+lag,by=1)]),
- y=transform(y[var2,seq(from=-lag,to=ncol(y),by=1)]),
- method=method
- )
- }
- val
- }
-}
-
-probe.cor <- function (
- vars,
- lag,
- method = c("pearson", "kendall", "spearman"),
- transform = identity
- ) {
- method <- match.arg(method)
- lag <- as.integer(lag)
- transform <- match.fun(transform)
- var1 <- vars[1L]
- if (length(vars)>1)
- var2 <- vars[2L]
- else
- var2 <- var1
- function (y) {
- if (lag>=0) {
- val <- cor(
- x=transform(y[var1,seq(from=1+lag,to=ncol(y),by=1)]),
- y=transform(y[var2,seq(from=1,to=ncol(y)-lag,by=1)]),
- method=method
- )
- } else {
- val <- cor(
- x=transform(y[var1,seq(from=1,to=ncol(y)+lag,by=1)]),
- y=transform(y[var2,seq(from=-lag,to=ncol(y),by=1)]),
- method=method
- )
- }
- val
- }
-}
-
-probe.acf <- function (var, lags, type = c("covariance", "correlation"), transform = identity) {
- type <- match.arg(type)
- corr <- type=="correlation"
- transform <- match.fun(transform)
- if (corr && any(lags==0)) {
- warning("useless zero lag discarded in ",sQuote("probe.acf"))
- lags <- lags[lags!=0]
- }
- lags <- as.integer(lags)
- function (y) .Call(
- probe_acf,
- x=transform(y[var,,drop=FALSE]),
- lags=lags,
- corr=corr
- )
-}
-
-probe.ccf <- function (vars, lags, type = c("covariance", "correlation"), transform = identity) {
- type <- match.arg(type)
- corr <- type=="correlation"
- transform <- match.fun(transform)
- if (length(vars)!=2)
- stop(sQuote("vars")," must name two variables")
- lags <- as.integer(lags)
- function (y) .Call(
- probe_ccf,
- x=transform(y[vars[1L],,drop=TRUE]),
- y=transform(y[vars[2L],,drop=TRUE]),
- lags=lags,
- corr=corr
- )
-}
-
-probe.marginal <- function (var, ref, order = 3, diff = 1, transform = identity) {
- if (length(var)>1) stop(sQuote("probe.marginal")," is a univariate probe")
- transform <- match.fun(transform)
- setup <- .Call(probe_marginal_setup,transform(ref),order,diff)
- function (y) .Call(
- probe_marginal_solve,
- x=transform(y[var,,drop=TRUE]),
- setup=setup,
- diff=diff
- )
-}
-
-probe.nlar <- function (var, lags, powers, transform = identity) {
- if (length(var)>1) stop(sQuote("probe.nlar")," is a univariate probe")
- transform <- match.fun(transform)
- if (any(lags<1)||any(powers<1))
- stop(sQuote("lags")," and ",sQuote("powers")," must be positive integers")
- if (length(lags)<length(powers)) {
- if (length(lags)>1) stop(sQuote("lags")," must match ",sQuote("powers")," in length, or have length 1")
- lags <- rep(lags,length(powers))
- } else if (length(lags)>length(powers)) {
- if (length(powers)>1) stop(sQuote("powers")," must match ",sQuote("lags")," in length, or have length 1")
- powers <- rep(powers,length(lags))
- }
- lags <- as.integer(lags)
- powers <- as.integer(powers)
- function (y) .Call(
- probe_nlar,
- x=transform(y[var,,drop=TRUE]),
- lags=lags,
- powers=powers
- )
-}
Deleted: pkg/pomp/R/bsmc.R
===================================================================
--- pkg/pomp/R/bsmc.R 2015-07-07 13:21:39 UTC (rev 1255)
+++ pkg/pomp/R/bsmc.R 2015-08-27 13:33:05 UTC (rev 1256)
@@ -1,446 +0,0 @@
-## Bayesian particle filtering codes
-##
-## in annotation L&W AGM == Liu & West "A General Algorithm"
-##
-## params = the initial particles for the parameter values;
-## these should be drawn from the prior distribution for the parameters
-## est = names of parameters to estimate; other parameters are not updated.
-## smooth = parameter 'h' from AGM
-## ntries = number of samplesto draw from x_{t+1} | x(k)_{t} to estimate
-## mean of mu(k)_t+1 as in sect 2.2 Liu & West
-## lower = lower bounds on prior
-## upper = upper bounds on prior
-
-setClass(
- "bsmcd.pomp",
- contains="pomp",
- slots=c(
- transform="logical",
- post="array",
- prior="array",
- est="character",
- eff.sample.size="numeric",
- smooth="numeric",
- seed="integer",
- nfail="integer",
- cond.log.evidence="numeric",
- log.evidence="numeric"
- )
- )
-
-bsmc.internal <- function (object, params, Np, est,
- smooth = 0.1,
- ntries = 1,
- tol = 1e-17,
- lower = -Inf, upper = Inf,
- seed = NULL,
- verbose = getOption("verbose"),
- max.fail = 0,
- transform = FALSE,
- .getnativesymbolinfo = TRUE,
- ...) {
-
- pompLoad(object)
-
- gnsi.rproc <- gnsi.dmeas <- as.logical(.getnativesymbolinfo)
- ptsi.inv <- ptsi.for <- TRUE
- transform <- as.logical(transform)
-
- if (missing(seed)) seed <- NULL
- if (!is.null(seed)) {
- if (!exists(".Random.seed",where=.GlobalEnv))
- runif(n=1L) ## need to initialize the RNG
- save.seed <- get(".Random.seed",pos=.GlobalEnv)
- set.seed(seed)
- }
-
- error.prefix <- paste(sQuote("bsmc"),"error: ")
-
- if (missing(params)) {
- if (length(coef(object))>0) {
- params <- coef(object)
- } else {
- stop(error.prefix,sQuote("params")," must be supplied",call.=FALSE)
- }
- }
-
- if (missing(Np)) Np <- NCOL(params)
- else if (is.matrix(params)&&(Np!=ncol(params)))
- warning(sQuote("Np")," is ignored when ",sQuote("params")," is a matrix")
-
- if ((!is.matrix(params)) && (Np > 1))
- params <- rprior(object,params=parmat(params,Np))
-
- if (transform)
- params <- partrans(object,params,dir="toEstimationScale",
- .getnativesymbolinfo=ptsi.inv)
- ptsi.inv <- FALSE
-
- ntimes <- length(time(object))
- npars <- nrow(params)
- paramnames <- rownames(params)
- prior <- params
-
- if (missing(est))
- est <- paramnames[apply(params,1,function(x)diff(range(x))>0)]
- estind <- match(est,paramnames)
- npars.est <- length(estind)
-
- if (npars.est<1)
- stop(error.prefix,"no parameters to estimate",call.=FALSE)
-
- if (is.null(paramnames))
- stop(error.prefix,sQuote("params")," must have rownames",call.=FALSE)
-
- if ((length(smooth)!=1)||(smooth>1)||(smooth<=0))
- stop(error.prefix,sQuote("smooth")," must be a scalar in [0,1)",call.=FALSE)
-
- hsq <- smooth^2 # see Liu & West eq(3.6) p10
- shrink <- sqrt(1-hsq)
-
- if (
- ((length(lower)>1)&&(length(lower)!=npars.est))||
- ((length(upper)>1)&&(length(upper)!=npars.est))
- ) {
- stop(
- error.prefix,
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/pomp -r 1256
More information about the pomp-commits
mailing list