[Pomp-commits] r469 - in pkg: . R inst inst/doc src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed May 11 14:42:14 CEST 2011
Author: kingaa
Date: 2011-05-11 14:42:13 +0200 (Wed, 11 May 2011)
New Revision: 469
Modified:
pkg/DESCRIPTION
pkg/R/pfilter.R
pkg/inst/ChangeLog
pkg/inst/NEWS
pkg/inst/doc/advanced_topics_in_pomp.pdf
pkg/inst/doc/intro_to_pomp.pdf
pkg/src/pfilter.c
Log:
- eliminate unnecessary copying of identical parameter particles
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2011-05-10 15:35:12 UTC (rev 468)
+++ pkg/DESCRIPTION 2011-05-11 12:42:13 UTC (rev 469)
@@ -2,7 +2,7 @@
Type: Package
Title: Statistical inference for partially observed Markov processes
Version: 0.37-1
-Date: 2011-05-10
+Date: 2011-05-11
Author: Aaron A. King, Edward L. Ionides, Carles Breto, Steve Ellner, Bruce Kendall, Helen Wearing,
Matthew J. Ferrari, Michael Lavine, Daniel C. Reuman
Maintainer: Aaron A. King <kingaa at umich.edu>
Modified: pkg/R/pfilter.R
===================================================================
--- pkg/R/pfilter.R 2011-05-10 15:35:12 UTC (rev 468)
+++ pkg/R/pfilter.R 2011-05-11 12:42:13 UTC (rev 469)
@@ -44,9 +44,11 @@
if (missing(tol))
stop(sQuote("pfilter")," error: ",sQuote("tol")," must be specified",call.=FALSE)
+ one.par <- FALSE
times <- time(object,t0=TRUE)
ntimes <- length(times)-1
if (is.null(dim(params))) {
+ one.par <- TRUE # there is only one parameter vector
params <- matrix(
params,
nrow=length(params),
@@ -197,7 +199,8 @@
X,params,
random.walk,sigma,
pred.mean,pred.var,
- filter.mean,weights,tol
+ filter.mean,one.par,
+ weights,tol
),
silent=FALSE
)
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2011-05-10 15:35:12 UTC (rev 468)
+++ pkg/inst/ChangeLog 2011-05-11 12:42:13 UTC (rev 469)
@@ -1,5 +1,15 @@
+2011-05-10 kingaa
+
+ * [r468] DESCRIPTION:
+
2011-05-09 kingaa
+ * [r467] inst/ChangeLog, inst/NEWS,
+ inst/doc/advanced_topics_in_pomp.pdf, inst/doc/index.html,
+ inst/doc/intro_to_pomp.Rnw, inst/doc/intro_to_pomp.pdf: - add a
+ diagram to intro vignette
+ - add 'index.html' file for vignettes
+ - fix NEWS file format
* [r464] inst/NEWS: - update
* [r463] NAMESPACE, R/pomp.R, data/blowflies.rda, data/dacca.rda,
data/euler.sir.rda, data/gillespie.sir.rda, data/gompertz.rda,
Modified: pkg/inst/NEWS
===================================================================
--- pkg/inst/NEWS 2011-05-10 15:35:12 UTC (rev 468)
+++ pkg/inst/NEWS 2011-05-11 12:42:13 UTC (rev 469)
@@ -11,7 +11,7 @@
o The warning messages to do with the default behaviors of 'simulate' and 'trajectory' with respect to the arguments 'times' and 't0' have been removed.
These warnings were introduced in version 0.34-1 to alert users to changes in the default behavior of 'simulate' and 'trajectory' introduced with that version.
- See the documentation ("pomp?simulate", "pomp?trajectory") for a description of the new default behaviors.
+ See the help ("pomp?simulate", "pomp?trajectory") for details.
0.36-7
o 'trajectory' now gives a more informative error when no skeleton is present
Modified: pkg/inst/doc/advanced_topics_in_pomp.pdf
===================================================================
(Binary files differ)
Modified: pkg/inst/doc/intro_to_pomp.pdf
===================================================================
(Binary files differ)
Modified: pkg/src/pfilter.c
===================================================================
--- pkg/src/pfilter.c 2011-05-10 15:35:12 UTC (rev 468)
+++ pkg/src/pfilter.c 2011-05-11 12:42:13 UTC (rev 469)
@@ -52,7 +52,8 @@
SEXP pfilter_computations (SEXP x, SEXP params,
SEXP rw, SEXP rw_sd,
SEXP predmean, SEXP predvar,
- SEXP filtmean, SEXP weights, SEXP tol)
+ SEXP filtmean, SEXP onepar,
+ SEXP weights, SEXP tol)
{
int nprotect = 0;
SEXP pm = R_NilValue, pv = R_NilValue, fm = R_NilValue;
@@ -63,7 +64,7 @@
SEXP dimX, dimP, newdim, Xnames, Pnames, pindex;
int *dim, *pidx, lv;
int nvars, npars = 0, nrw = 0, nreps, offset, nlost;
- int do_rw, do_pm, do_pv, do_fm, all_fail = 0;
+ int do_rw, do_pm, do_pv, do_fm, is_op, all_fail = 0;
double sum, sumsq, vsq, ws, w, toler;
int j, k;
@@ -86,6 +87,8 @@
do_pm = *(LOGICAL(AS_LOGICAL(predmean))); // calculate prediction means?
do_pv = *(LOGICAL(AS_LOGICAL(predvar))); // calculate prediction variances?
do_fm = *(LOGICAL(AS_LOGICAL(filtmean))); // calculate filtering means?
+ is_op = *(LOGICAL(AS_LOGICAL(onepar))); // are all cols of 'params' the same?
+ is_op = is_op && !do_rw;
PROTECT(ess = NEW_NUMERIC(1)); nprotect++; // effective sample size
PROTECT(loglik = NEW_NUMERIC(1)); nprotect++; // log likelihood
@@ -115,7 +118,8 @@
*(LOGICAL(fail)) = all_fail;
if (do_rw) {
- PROTECT(pindex = matchnames(Pnames,rw_names)); nprotect++; // indices of parameters undergoing random walk
+ // indices of parameters undergoing random walk
+ PROTECT(pindex = matchnames(Pnames,rw_names)); nprotect++;
xp = REAL(params);
pidx = INTEGER(pindex);
nrw = LENGTH(rw_names);
@@ -224,29 +228,38 @@
st = REAL(newstates);
// create storage for new parameters
- xdim[0] = npars; xdim[1] = nreps;
- PROTECT(newparams = makearray(2,xdim)); nprotect++;
- setrownames(newparams,Pnames,2);
- ps = REAL(params);
- pt = REAL(newparams);
+ if (!is_op) {
+ xdim[0] = npars; xdim[1] = nreps;
+ PROTECT(newparams = makearray(2,xdim)); nprotect++;
+ setrownames(newparams,Pnames,2);
+ ps = REAL(params);
+ pt = REAL(newparams);
+ }
// resample
nosort_resamp(nreps,REAL(weights),sample,0);
for (k = 0; k < nreps; k++) { // copy the particles
- for (j = 0, xx = ss+nvars*sample[k]; j < nvars; j++, st++, xx++) *st = *xx;
- for (j = 0, xp = ps+npars*sample[k]; j < npars; j++, pt++, xp++) *pt = *xp;
+ for (j = 0, xx = ss+nvars*sample[k]; j < nvars; j++, st++, xx++)
+ *st = *xx;
+ if (!is_op) {
+ for (j = 0, xp = ps+npars*sample[k]; j < npars; j++, pt++, xp++)
+ *pt = *xp;
+ }
}
+
} else { // don't resample: just drop 3rd dimension in x prior to return
+
PROTECT(newdim = NEW_INTEGER(2)); nprotect++;
dim = INTEGER(newdim);
dim[0] = nvars; dim[1] = nreps;
SET_DIM(x,newdim);
setrownames(x,Xnames,2);
+
}
if (do_rw) { // if random walk, adjust prediction variance and move particles
xx = REAL(rw_sd);
- xp = (all_fail) ? REAL(params) : REAL(newparams);
+ xp = (all_fail&&(!is_op)) ? REAL(params) : REAL(newparams);
for (j = 0; j < nrw; j++) {
offset = pidx[j];
vsq = xx[j];
@@ -278,9 +291,13 @@
if (all_fail) {
SET_ELEMENT(retval,3,x);
+ } else {
+ SET_ELEMENT(retval,3,newstates);
+ }
+
+ if (all_fail||is_op) {
SET_ELEMENT(retval,4,params);
} else {
- SET_ELEMENT(retval,3,newstates);
SET_ELEMENT(retval,4,newparams);
}
More information about the pomp-commits
mailing list