[Pomp-commits] r1087 - pkg/pomp/R

[noreply at r-forge.r-project.org]

Author: kingaa
Date: 2015-02-22 20:43:23 +0100 (Sun, 22 Feb 2015)
New Revision: 1087

Modified:
   pkg/pomp/R/pmcmc-methods.R
   pkg/pomp/R/pmcmc.R
Log:
- return 'pars' slot to pmcmc object

Modified: pkg/pomp/R/pmcmc-methods.R
===================================================================
--- pkg/pomp/R/pmcmc-methods.R	2015-02-22 19:43:18 UTC (rev 1086)
+++ pkg/pomp/R/pmcmc-methods.R	2015-02-22 19:43:23 UTC (rev 1087)
@@ -127,8 +127,7 @@
   mar.multi <- c(0,5.1,0,2.1)
   oma.multi <- c(6,0,5,0)
   xx <- z[[1]]
-  estnames <- apply(xx at conv.rec,2,function(x)diff(range(x))>0)
-  estnames <- names(estnames[estnames])
+  estnames <- xx at pars
 
   ## plot pmcmc convergence diagnostics
   other.diagnostics <- c("loglik", "log.prior","nfail")

Modified: pkg/pomp/R/pmcmc.R
===================================================================
--- pkg/pomp/R/pmcmc.R	2015-02-22 19:43:18 UTC (rev 1086)
+++ pkg/pomp/R/pmcmc.R	2015-02-22 19:43:23 UTC (rev 1087)
@@ -3,12 +3,14 @@
          'pmcmc',
          contains='pfilterd.pomp',
          slots=c(
+           pars = 'character',
            Nmcmc = 'integer',
            proposal = 'function',
            conv.rec = 'array',
            log.prior = 'numeric'
            ),
          prototype=prototype(
+           pars = character(0),
            Nmcmc = 0L,
            proposal = function (...) stop("proposal not specified"),
            conv.rec=array(dim=c(0,0)),
@@ -44,9 +46,9 @@
   ## test proposal distribution
   theta <- try(proposal(start))
   if (inherits(theta,"try-error"))
-    stop("pmcmc error: error in proposal function")
+    stop("pmcmc error: error in proposal function",call.=FALSE)
   if (is.null(names(theta)) || !is.numeric(theta))
-    stop("pmcmc error: ",sQuote("proposal")," must return a named numeric vector")
+    stop("pmcmc error: ",sQuote("proposal")," must return a named numeric vector",call.=FALSE)
 
   ntimes <- length(time(object))
   if (missing(Np))
@@ -164,10 +166,14 @@
 
   }
 
+  pars <- apply(conv.rec,2,function(x)diff(range(x))>0)
+  pars <- names(pars[pars])
+
   new(
       "pmcmc",
       pfp,
       params=theta,
+      pars=pars,
       Nmcmc=Nmcmc,
       proposal=proposal,
       Np=Np,
@@ -190,10 +196,12 @@
             if (missing(Np))
               stop("pmcmc error: ",sQuote("Np")," must be specified",call.=FALSE)
               
+            if (missing(proposal)) proposal <- NULL
+
             if (!missing(rw.sd)) {
               warning("pmcmc warning: ",sQuote("rw.sd")," is a deprecated argument.",
                       "Use ",sQuote("proposal")," instead.",call.=FALSE)
-              if (missing(proposal)) {
+              if (is.null(proposal)) {
                 proposal <- mvn.diag.rw(rw.sd=rw.sd)
               } else {
                 warning("pmcmc warning: since ",sQuote("proposal"),
@@ -201,6 +209,9 @@
               }
             }
 
+            if (is.null(proposal))
+              stop("pmcmc error: ",sQuote("proposal")," must be specified",call.=FALSE)
+
             if (!missing(pars))
               warning("pmcmc warning: ",sQuote("pars")," is a deprecated argument and will be ignored.",call.=FALSE)