From noreply at r-forge.r-project.org Thu Aug 27 15:33:08 2015 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 27 Aug 2015 15:33:08 +0200 (CEST) Subject: [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 Message-ID: <20150827133308.BDDA51853B2@r-forge.r-project.org> 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 (hi0) - 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)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