From noreply at r-forge.r-project.org Mon Jun 9 18:30:31 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 9 Jun 2014 18:30:31 +0200 (CEST) Subject: [Pomp-commits] r967 - pkg/pomp/R Message-ID: <20140609163031.5A80A187363@r-forge.r-project.org> Author: kingaa Date: 2014-06-09 18:30:30 +0200 (Mon, 09 Jun 2014) New Revision: 967 Modified: pkg/pomp/R/bsmc.R pkg/pomp/R/minim.R pkg/pomp/R/nlf-guts.R pkg/pomp/R/nlf.R pkg/pomp/R/spect-match.R Log: - remove unneeded explicit namespace references Modified: pkg/pomp/R/bsmc.R =================================================================== --- pkg/pomp/R/bsmc.R 2014-05-24 15:59:19 UTC (rev 966) +++ pkg/pomp/R/bsmc.R 2014-06-09 16:30:30 UTC (rev 967) @@ -223,12 +223,12 @@ ## sample new parameter vector as per L&W AGM (3) and Liu & West eq(3.2) pvec <- try( - mvtnorm::rmvnorm( - n=Np, - mean=rep(0,npars.est), - sigma=hsq*params.var, - method="svd" - ), + rmvnorm( + n=Np, + mean=rep(0,npars.est), + sigma=hsq*params.var, + method="svd" + ), silent=FALSE ) if (inherits(pvec,"try-error")) Modified: pkg/pomp/R/minim.R =================================================================== --- pkg/pomp/R/minim.R 2014-05-24 15:59:19 UTC (rev 966) +++ pkg/pomp/R/minim.R 2014-06-09 16:30:30 UTC (rev 967) @@ -32,7 +32,7 @@ opts <- list(...) if (method == 'subplex') { - opt <- subplex::subplex(par=guess,fn=objfun,control=opts) + opt <- subplex(par=guess,fn=objfun,control=opts) } else if (method=="sannbox") { opt <- sannbox(par=guess,fn=objfun,control=opts) } else if (method=="nloptr") { Modified: pkg/pomp/R/nlf-guts.R =================================================================== --- pkg/pomp/R/nlf-guts.R 2014-05-24 15:59:19 UTC (rev 966) +++ pkg/pomp/R/nlf-guts.R 2014-06-09 16:30:30 UTC (rev 967) @@ -185,7 +185,7 @@ LQL <- dnorm(prediction.errors[,1],mean=0,sd=sigma.model,log=TRUE) } else { sigma.model <- cov(model.residuals) - LQL <- mvtnorm::dmvnorm(prediction.errors,sigma=sigma.model,log=TRUE) ## NOTE: This could be improved using GLS. + LQL <- dmvnorm(prediction.errors,sigma=sigma.model,log=TRUE) ## NOTE: This could be improved using GLS. } LQL Modified: pkg/pomp/R/nlf.R =================================================================== --- pkg/pomp/R/nlf.R 2014-05-24 15:59:19 UTC (rev 966) +++ pkg/pomp/R/nlf.R 2014-06-09 16:30:30 UTC (rev 967) @@ -96,26 +96,26 @@ } if (method == 'subplex') { - opt <- subplex::subplex( - par=guess, - fn=nlf.objfun, - 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(...) - ) + opt <- subplex( + par=guess, + fn=nlf.objfun, + 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(...) + ) } else { opt <- optim( par=guess, Modified: pkg/pomp/R/spect-match.R =================================================================== --- pkg/pomp/R/spect-match.R 2014-05-24 15:59:19 UTC (rev 966) +++ pkg/pomp/R/spect-match.R 2014-06-09 16:30:30 UTC (rev 967) @@ -168,23 +168,23 @@ msg <- "no optimization performed" } else { if (method == 'subplex') { - opt <- subplex::subplex( - par=guess, - fn=obj.fn, - est=par.index, - object=object, - params=params, - vars=vars, - ker=ker, - nsim=nsim, - seed=seed, - transform=transform, - detrend=detrend, - weights=weights, - data.spec=ds, - fail.value=fail.value, - control=list(...) - ) + opt <- subplex( + par=guess, + fn=obj.fn, + est=par.index, + object=object, + params=params, + vars=vars, + ker=ker, + nsim=nsim, + seed=seed, + transform=transform, + detrend=detrend, + weights=weights, + data.spec=ds, + fail.value=fail.value, + control=list(...) + ) } else { opt <- optim( par=guess, From noreply at r-forge.r-project.org Mon Jun 9 18:30:39 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 9 Jun 2014 18:30:39 +0200 (CEST) Subject: [Pomp-commits] r968 - pkg/pomp/src Message-ID: <20140609163039.A7475187368@r-forge.r-project.org> Author: kingaa Date: 2014-06-09 18:30:39 +0200 (Mon, 09 Jun 2014) New Revision: 968 Modified: pkg/pomp/src/SSA_wrapper.c pkg/pomp/src/euler.c pkg/pomp/src/mif.c pkg/pomp/src/pfilter.c pkg/pomp/src/pomp_internal.h pkg/pomp/src/rmeasure.c pkg/pomp/src/rprior.c pkg/pomp/src/skeleton.c pkg/pomp/src/trajectory.c Log: - more informative error messages when variable names are not found using 'matchnames' Modified: pkg/pomp/src/SSA_wrapper.c =================================================================== --- pkg/pomp/src/SSA_wrapper.c 2014-06-09 16:30:30 UTC (rev 967) +++ pkg/pomp/src/SSA_wrapper.c 2014-06-09 16:30:39 UTC (rev 968) @@ -157,26 +157,26 @@ PROTECT(X = makearray(3,xdim)); nprotect++; setrownames(X,Snames,3); - if (nstates>0) { - PROTECT(sindex = MATCHROWNAMES(xstart,statenames)); nprotect++; + if (nstates>0) { + PROTECT(sindex = MATCHROWNAMES(xstart,statenames,"state variables")); nprotect++; sidx = INTEGER(sindex); } else { sidx = 0; } if (nparams>0) { - PROTECT(pindex = MATCHROWNAMES(params,paramnames)); nprotect++; + PROTECT(pindex = MATCHROWNAMES(params,paramnames,"parameters")); nprotect++; pidx = INTEGER(pindex); } else { pidx = 0; } if (ncovars>0) { - PROTECT(cindex = MATCHCOLNAMES(covar,covarnames)); nprotect++; + PROTECT(cindex = MATCHCOLNAMES(covar,covarnames,"covariates")); nprotect++; cidx = INTEGER(cindex); } else { cidx = 0; } if (nzeros>0) { - PROTECT(zindex = MATCHROWNAMES(xstart,zeronames)); nprotect++; + PROTECT(zindex = MATCHROWNAMES(xstart,zeronames,"state variables")); nprotect++; zidx = INTEGER(zindex); } else { zidx = 0; Modified: pkg/pomp/src/euler.c =================================================================== --- pkg/pomp/src/euler.c 2014-06-09 16:30:30 UTC (rev 967) +++ pkg/pomp/src/euler.c 2014-06-09 16:30:39 UTC (rev 968) @@ -40,7 +40,7 @@ // indices of accumulator variables nzeros = LENGTH(zeronames); - zidx = INTEGER(PROTECT(matchnames(Snames,zeronames))); nprotect++; + zidx = INTEGER(PROTECT(matchnames(Snames,zeronames,"state variables"))); nprotect++; // extract user function PROTECT(fn = pomp_fun_handler(func,gnsi,&mode)); nprotect++; @@ -78,9 +78,9 @@ case 1: // native code // construct state, parameter, covariate indices - sidx = INTEGER(PROTECT(matchnames(Snames,GET_SLOT(func,install("statenames"))))); nprotect++; - pidx = INTEGER(PROTECT(matchnames(Pnames,GET_SLOT(func,install("paramnames"))))); nprotect++; - cidx = INTEGER(PROTECT(matchnames(Cnames,GET_SLOT(func,install("covarnames"))))); nprotect++; + sidx = INTEGER(PROTECT(matchnames(Snames,GET_SLOT(func,install("statenames")),"state variables"))); nprotect++; + pidx = INTEGER(PROTECT(matchnames(Pnames,GET_SLOT(func,install("paramnames")),"parameters"))); nprotect++; + cidx = INTEGER(PROTECT(matchnames(Cnames,GET_SLOT(func,install("covarnames")),"covariates"))); nprotect++; ff = (pomp_onestep_sim *) R_ExternalPtrAddr(fn); @@ -181,14 +181,14 @@ PROTECT(ans = eval(fcall,rho)); nprotect++; // evaluate the call if (LENGTH(ans) != nvars) { - error("user 'step.fun' returns a vector of %d states but %d are expected: compare initial conditions?", + error("user 'step.fun' returns a vector of %d state variables but %d are expected: compare initial conditions?", LENGTH(ans),nvars); } PROTECT(nm = GET_NAMES(ans)); nprotect++; use_names = !isNull(nm); if (use_names) { - posn = INTEGER(PROTECT(matchnames(Snames,nm))); nprotect++; + posn = INTEGER(PROTECT(matchnames(Snames,nm,"state variables"))); nprotect++; } ap = REAL(AS_NUMERIC(ans)); @@ -316,9 +316,9 @@ case 1: // native code // construct state, parameter, covariate indices - sidx = INTEGER(PROTECT(matchnames(Snames,GET_SLOT(func,install("statenames"))))); nprotect++; - pidx = INTEGER(PROTECT(matchnames(Pnames,GET_SLOT(func,install("paramnames"))))); nprotect++; - cidx = INTEGER(PROTECT(matchnames(Cnames,GET_SLOT(func,install("covarnames"))))); nprotect++; + sidx = INTEGER(PROTECT(matchnames(Snames,GET_SLOT(func,install("statenames")),"state variables"))); nprotect++; + pidx = INTEGER(PROTECT(matchnames(Pnames,GET_SLOT(func,install("paramnames")),"parameters"))); nprotect++; + cidx = INTEGER(PROTECT(matchnames(Cnames,GET_SLOT(func,install("covarnames")),"covariates"))); nprotect++; ff = (pomp_onestep_pdf *) R_ExternalPtrAddr(fn); Modified: pkg/pomp/src/mif.c =================================================================== --- pkg/pomp/src/mif.c 2014-06-09 16:30:30 UTC (rev 967) +++ pkg/pomp/src/mif.c 2014-06-09 16:30:39 UTC (rev 968) @@ -26,10 +26,10 @@ dim = INTEGER(GET_DIM(FM)); nfm = dim[0]; ntimes = dim[1]; dim = INTEGER(GET_DIM(PV)); npv = dim[0]; - sidx = INTEGER(PROTECT(MATCHNAMES(sigma,pars))); nprotect++; - thidx = INTEGER(PROTECT(MATCHNAMES(theta,pars))); nprotect++; - midx = INTEGER(PROTECT(MATCHROWNAMES(FM,pars))); nprotect++; - vidx = INTEGER(PROTECT(MATCHROWNAMES(PV,pars))); nprotect++; + sidx = INTEGER(PROTECT(MATCHNAMES(sigma,pars,"random-walk SDs"))); nprotect++; + thidx = INTEGER(PROTECT(MATCHNAMES(theta,pars,"parameters"))); nprotect++; + midx = INTEGER(PROTECT(MATCHROWNAMES(FM,pars,"filter-mean variables"))); nprotect++; + vidx = INTEGER(PROTECT(MATCHROWNAMES(PV,pars,"prediction-variance variables"))); nprotect++; PROTECT(newtheta = duplicate(theta)); nprotect++; Modified: pkg/pomp/src/pfilter.c =================================================================== --- pkg/pomp/src/pfilter.c 2014-06-09 16:30:30 UTC (rev 967) +++ pkg/pomp/src/pfilter.c 2014-06-09 16:30:39 UTC (rev 968) @@ -120,7 +120,7 @@ if (do_rw) { // indices of parameters undergoing random walk - PROTECT(pindex = matchnames(Pnames,rw_names)); nprotect++; + PROTECT(pindex = matchnames(Pnames,rw_names,"parameters")); nprotect++; xp = REAL(params); pidx = INTEGER(pindex); nrw = LENGTH(rw_names); Modified: pkg/pomp/src/pomp_internal.h =================================================================== --- pkg/pomp/src/pomp_internal.h 2014-06-09 16:30:30 UTC (rev 967) +++ pkg/pomp/src/pomp_internal.h 2014-06-09 16:30:39 UTC (rev 968) @@ -10,9 +10,9 @@ #include "pomp.h" -# define MATCHNAMES(X,N) (matchnames(GET_NAMES(X),(N))) -# define MATCHROWNAMES(X,N) (matchnames(GET_ROWNAMES(GET_DIMNAMES(X)),(N))) -# define MATCHCOLNAMES(X,N) (matchnames(GET_COLNAMES(GET_DIMNAMES(X)),(N))) +# define MATCHNAMES(X,N,W) (matchnames(GET_NAMES(X),(N),(W))) +# define MATCHROWNAMES(X,N,W) (matchnames(GET_ROWNAMES(GET_DIMNAMES(X)),(N),(W))) +# define MATCHCOLNAMES(X,N,W) (matchnames(GET_COLNAMES(GET_DIMNAMES(X)),(N),(W))) # define MATCH_CHAR_TO_ROWNAMES(X,N,A) (match_char_to_names(GET_ROWNAMES(GET_DIMNAMES(X)),(N),(A))) // lookup-table structure, as used internally @@ -91,7 +91,7 @@ return x; } -static R_INLINE SEXP matchnames (SEXP x, SEXP names) { +static R_INLINE SEXP matchnames (SEXP x, SEXP names, const char *where) { int nprotect = 0; int n = length(names); int *idx, k; @@ -100,7 +100,10 @@ PROTECT(index = match(x,names,0)); nprotect++; idx = INTEGER(index); for (k = 0; k < n; k++) { - if (idx[k]==0) error("variable '%s' not found",CHARACTER_DATA(STRING_ELT(nm,k))); + if (idx[k]==0) + error("variable '%s' not found among the %s", + CHARACTER_DATA(STRING_ELT(nm,k)), + where); idx[k] -= 1; } UNPROTECT(nprotect); @@ -132,7 +135,7 @@ SEXP slotnames, index; PROTECT(slotnames = GET_SLOT(object,install(slot))); if (LENGTH(slotnames) > 0) { - PROTECT(index = matchnames(names,slotnames)); + PROTECT(index = matchnames(names,slotnames,slot)); } else { PROTECT(index = NEW_INTEGER(0)); } Modified: pkg/pomp/src/rmeasure.c =================================================================== --- pkg/pomp/src/rmeasure.c 2014-06-09 16:30:30 UTC (rev 967) +++ pkg/pomp/src/rmeasure.c 2014-06-09 16:30:39 UTC (rev 968) @@ -163,7 +163,7 @@ PROTECT(nm = GET_NAMES(ans)); nprotect++; use_names = !isNull(nm); if (use_names) { // match names against names from data slot - posn = INTEGER(PROTECT(matchnames(Onames,nm))); nprotect++; + posn = INTEGER(PROTECT(matchnames(Onames,nm,"observables"))); nprotect++; } else { posn = 0; } Modified: pkg/pomp/src/rprior.c =================================================================== --- pkg/pomp/src/rprior.c 2014-06-09 16:30:30 UTC (rev 967) +++ pkg/pomp/src/rprior.c 2014-06-09 16:30:39 UTC (rev 968) @@ -80,7 +80,7 @@ PROTECT(nm = GET_NAMES(ans)); nprotect++; use_names = !isNull(nm); if (use_names) { // match names against names from params slot - posn = INTEGER(PROTECT(matchnames(Pnames,nm))); nprotect++; + posn = INTEGER(PROTECT(matchnames(Pnames,nm,"parameters"))); nprotect++; } else { posn = 0; } Modified: pkg/pomp/src/skeleton.c =================================================================== --- pkg/pomp/src/skeleton.c 2014-06-09 16:30:30 UTC (rev 967) +++ pkg/pomp/src/skeleton.c 2014-06-09 16:30:39 UTC (rev 968) @@ -67,7 +67,7 @@ PROTECT(nm = GET_NAMES(ans)); nprotect++; use_names = !isNull(nm); if (use_names) { - posn = INTEGER(PROTECT(matchnames(Snames,nm))); nprotect++; + posn = INTEGER(PROTECT(matchnames(Snames,nm,"state variables"))); nprotect++; } else { posn = 0; } Modified: pkg/pomp/src/trajectory.c =================================================================== --- pkg/pomp/src/trajectory.c 2014-06-09 16:30:30 UTC (rev 967) +++ pkg/pomp/src/trajectory.c 2014-06-09 16:30:39 UTC (rev 968) @@ -75,7 +75,7 @@ PROTECT(nm = GET_NAMES(ans)); nprotect++; use_names = !isNull(nm); if (use_names) { - posn = INTEGER(PROTECT(matchnames(Snames,nm))); nprotect++; + posn = INTEGER(PROTECT(matchnames(Snames,nm,"state variables"))); nprotect++; } fs = REAL(AS_NUMERIC(ans)); first = 0; @@ -144,7 +144,7 @@ PROTECT(zeronames = GET_SLOT(object,install("zeronames"))); nprotect++; nzeros = LENGTH(zeronames); if (nzeros > 0) { - zidx = INTEGER(PROTECT(matchnames(Snames,zeronames))); nprotect++; + zidx = INTEGER(PROTECT(matchnames(Snames,zeronames,"state variables"))); nprotect++; } // create array to store results From noreply at r-forge.r-project.org Mon Jun 9 18:30:46 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 9 Jun 2014 18:30:46 +0200 (CEST) Subject: [Pomp-commits] r969 - pkg/pomp/man Message-ID: <20140609163046.AD5F518736E@r-forge.r-project.org> Author: kingaa Date: 2014-06-09 18:30:46 +0200 (Mon, 09 Jun 2014) New Revision: 969 Modified: pkg/pomp/man/mif.Rd Log: - fix documentation error Modified: pkg/pomp/man/mif.Rd =================================================================== --- pkg/pomp/man/mif.Rd 2014-06-09 16:30:39 UTC (rev 968) +++ pkg/pomp/man/mif.Rd 2014-06-09 16:30:46 UTC (rev 969) @@ -93,7 +93,7 @@ specifications for the cooling schedule, i.e., the manner in which the intensity of the parameter perturbations is reduced with successive filtering iterations. \code{cooling.type} specifies the nature of the cooling schedule. When \code{cooling.type="geometric"}, on the n-th MIF iteration, the relative perturbation intensity is \code{cooling.fraction^(n/50)}. - When \code{cooling.type="hyperbolic"}, on the n-th MIF iteration, the relative perturbation intensity is \code{(s+1)(s+n)}, where \code{(s+1)/(s+50)=cooling.fraction}. + When \code{cooling.type="hyperbolic"}, on the n-th MIF iteration, the relative perturbation intensity is \code{(s+1)/(s+n)}, where \code{(s+1)/(s+50)=cooling.fraction}. \code{cooling.fraction} is the relative magnitude of the parameter perturbations after 50 MIF iterations. \code{cooling.factor} is now deprecated: to achieve the old behavior, use \code{cooling.type="geometric"} and \code{cooling.fraction=(cooling.factor)^50}. From noreply at r-forge.r-project.org Mon Jun 9 18:32:01 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 9 Jun 2014 18:32:01 +0200 (CEST) Subject: [Pomp-commits] r970 - pkg pkg/pomp pkg/pomp/R pkg/pomp/inst pkg/pomp/man pkg/pomp/tests www/content www/vignettes Message-ID: <20140609163201.1D164187379@r-forge.r-project.org> Author: kingaa Date: 2014-06-09 18:32:00 +0200 (Mon, 09 Jun 2014) New Revision: 970 Modified: pkg/Makefile pkg/pomp/DESCRIPTION pkg/pomp/NAMESPACE pkg/pomp/R/abc-methods.R pkg/pomp/R/pmcmc-methods.R pkg/pomp/inst/NEWS pkg/pomp/inst/NEWS.Rd pkg/pomp/man/abc-methods.Rd pkg/pomp/man/pmcmc-methods.Rd pkg/pomp/tests/abc.R pkg/pomp/tests/abc.Rout.save www/content/NEWS.html www/vignettes/advanced_topics_in_pomp.R www/vignettes/advanced_topics_in_pomp.Rnw www/vignettes/advanced_topics_in_pomp.pdf www/vignettes/intro_to_pomp.R www/vignettes/intro_to_pomp.Rnw www/vignettes/intro_to_pomp.pdf www/vignettes/pomp.pdf Log: - redefine the 'pmcmcList' class so that it contains 'list' - add 'abcList' class and associated methods - fix problems in vignettes associated with bug in knitr 1.6 Modified: pkg/Makefile =================================================================== --- pkg/Makefile 2014-06-09 16:30:46 UTC (rev 969) +++ pkg/Makefile 2014-06-09 16:32:00 UTC (rev 970) @@ -27,7 +27,7 @@ pomp/inst/include/pomp.h: pomp/src/pomp.h $(CP) $^ $@ -../www.vignettes: export POMP_BUILD_VIGNETTES=yes +pomp.vignettes: export POMP_BUILD_VIGNETTES=yes %.dist %.manual %.vignettes: export R_QPDF=qpdf %.dist %.manual %.vignettes: export R_GSCMD=gs %.dist %.manual %.vignettes: export GS_QUALITY=ebook @@ -123,7 +123,7 @@ $(TOUCH) $@ %.remove: - $(RCMD) REMOVE --library=$(INSTALL_DIR) $* + -$(RCMD) REMOVE --library=$(INSTALL_DIR) $* $(RM) $*.install %.publish: %.dist %.manual Modified: pkg/pomp/DESCRIPTION =================================================================== --- pkg/pomp/DESCRIPTION 2014-06-09 16:30:46 UTC (rev 969) +++ pkg/pomp/DESCRIPTION 2014-06-09 16:32:00 UTC (rev 970) @@ -1,8 +1,8 @@ Package: pomp Type: Package Title: Statistical inference for partially observed Markov processes -Version: 0.51-1 -Date: 2014-05-23 +Version: 0.51-2 +Date: 2014-06-10 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-09 16:30:46 UTC (rev 969) +++ pkg/pomp/NAMESPACE 2014-06-09 16:32:00 UTC (rev 970) @@ -48,7 +48,7 @@ traj.matched.pomp, probed.pomp,probe.matched.pomp, spect.pomp,spect.matched.pomp, - abc, + abc,abcList, Csnippet ) Modified: pkg/pomp/R/abc-methods.R =================================================================== --- pkg/pomp/R/abc-methods.R 2014-06-09 16:30:46 UTC (rev 969) +++ pkg/pomp/R/abc-methods.R 2014-06-09 16:32:00 UTC (rev 970) @@ -6,7 +6,7 @@ 'abc', function (object, pars, ...) { if (missing(pars)) pars <- colnames(object at conv.rec) - coda::mcmc(object at conv.rec[,pars]) + coda::mcmc(object at conv.rec[,pars,drop=FALSE]) } ) @@ -15,64 +15,165 @@ "plot", "abc", function (x, y, pars, scatter = FALSE, ...) { - if (missing(pars)) pars <- x at pars - if (scatter) { - pairs(as.matrix(conv.rec(x, pars))) + ## if (missing(pars)) pars <- x at pars + ## if (scatter) { + ## pairs(as.matrix(conv.rec(x,pars))) + ## } else { + ## plot.ts(conv.rec(x,pars),xlab="iteration",...) + ## } + abc.diagnostics(c(x),pars=pars,scatter=scatter,...) + } + ) + +## 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 { - plot.ts(conv.rec(x,pars),xlab="iteration",...) + p <- sapply(y,is,'abc') + pl <- sapply(y,is,'abcList') + if (any(!(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)) } } ) -compare.abc <- function (z) { - ## assumes that z is a list of abcs with identical structure - if (!is.list(z)) z <- list(z) - if (!all(sapply(z,function(x)is(x,'abc')))) - stop("compare.abc error: ", - sQuote("z"), - " must be a pmcmc object or a list of pmcmc objects",call.=FALSE) - mar.multi <- c(0,5.1,0,2.1) - oma.multi <- c(6,0,5,0) - xx <- z[[1]] - estnames <- xx at pars - parnames <- names(coef(xx)) - unestnames <- parnames[-match(estnames,parnames)] +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 (any(!(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)) + } + } + ) - ## plot pmcmc 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 pompExample(ou2) newly created pomp object(s): ou2 @@ -117,6 +119,14 @@ + ) > plot(abc6) > +> try(abc7 <- c(abc2,abc3)) +Error in validObject(.Object) : + invalid class "abcList" object: error in 'c': to be combined, 'abc' objects must have chains of equal length +> plot(abc7 <- c(abc2,abc4)) +> plot(abc7,scatter=TRUE) +> plot(conv.rec(c(abc2,abc4))) +> plot(conv.rec(c(abc7,abc6))) +> > dev.off() null device 1 @@ -124,4 +134,4 @@ > > proc.time() user system elapsed - 7.884 0.052 8.120 + 8.616 0.052 8.991 Modified: www/content/NEWS.html =================================================================== --- www/content/NEWS.html 2014-06-09 16:30:46 UTC (rev 969) +++ www/content/NEWS.html 2014-06-09 16:32:00 UTC (rev 970) @@ -8,22 +8,40 @@

News for package ‘pomp’

+

Changes in pomp version 0.51-2

+ + + + + +

Changes in pomp version 0.51-1

@@ -68,7 +86,7 @@