[Pomp-commits] r427 - in pkg: . R inst man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Nov 24 18:35:11 CET 2010


Author: kingaa
Date: 2010-11-24 18:35:11 +0100 (Wed, 24 Nov 2010)
New Revision: 427

Modified:
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/R/aaa.R
   pkg/R/probe-match.R
   pkg/R/traj-match.R
   pkg/inst/NEWS
   pkg/man/probe.Rd
Log:
- make 'probe.match' into a method
- tinker with generics


Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2010-11-24 11:03:29 UTC (rev 426)
+++ pkg/DESCRIPTION	2010-11-24 17:35:11 UTC (rev 427)
@@ -2,7 +2,7 @@
 Type: Package
 Title: Statistical inference for partially observed Markov processes
 Version: 0.36-1
-Date: 2010-11-23
+Date: 2010-11-24
 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/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2010-11-24 11:03:29 UTC (rev 426)
+++ pkg/NAMESPACE	2010-11-24 17:35:11 UTC (rev 427)
@@ -32,23 +32,26 @@
 importFrom(deSolve,ode)
 
 exportClasses(
-              "pomp","pfilterd.pomp",
-              "mif","pmcmc",
-              "traj.matched.pomp",
-              "probed.pomp","probe.matched.pomp"
-              ,"spect.pomp","spect.matched.pomp"
+              pomp,
+              pfilterd.pomp,
+              mif,
+              pmcmc,
+              traj.matched.pomp,
+              probed.pomp,probe.matched.pomp,
+              spect.pomp,spect.matched.pomp
               )
 
 exportMethods(
-              'plot','show','print','coerce','summary','logLik','window',
-              'dprocess','rprocess','rmeasure','dmeasure','init.state','skeleton',
-              'data.array','obs','coef','time','time<-','timezero','timezero<-','$',
-              'simulate','pfilter',
-              'particles','mif','continue','coef<-','states','trajectory',
-              'pred.mean','pred.var','filter.mean','conv.rec',
-              'bsmc',
-              'pmcmc','dprior',
-              'spect','probe'
+              plot,show,print,coerce,summary,logLik,window,"$",
+              dprocess,rprocess,rmeasure,dmeasure,init.state,skeleton,
+              data.array,obs,coef,"coef<-",time,"time<-",timezero,"timezero<-",
+              simulate,pfilter,
+              particles,mif,continue,states,trajectory,
+              pred.mean,pred.var,filter.mean,conv.rec,
+              bsmc,
+              pmcmc,dprior,
+              spect,probe,
+              probe.match,traj.match
               )
 
 export(
@@ -69,9 +72,6 @@
        periodic.bspline.basis,
        compare.mif,
        nlf,
-       skeleton,
-       trajectory,
-       traj.match,
        probe.mean,
        probe.median,
        probe.var,
@@ -82,6 +82,5 @@
        probe.ccf,
        probe.nlar,
        probe.marginal,
-       probe.match,
        spect.match
        )

Modified: pkg/R/aaa.R
===================================================================
--- pkg/R/aaa.R	2010-11-24 11:03:29 UTC (rev 426)
+++ pkg/R/aaa.R	2010-11-24 17:35:11 UTC (rev 427)
@@ -6,9 +6,9 @@
 ##   cat("See the NEWS file for important information\n")
 ##}
 
-setGeneric("print")
-setGeneric("summary")
+setGeneric("print",function(x,...)standardGeneric("print"))
 setGeneric("plot",function(x,y,...)standardGeneric("plot"))
+setGeneric("summary",function(object,...)standardGeneric("summary"))
 setGeneric("simulate",function(object,nsim=1,seed=NULL,...)standardGeneric("simulate"))
 setGeneric("time",function(x,...)standardGeneric("time"))
 setGeneric("coef",function(object,...)standardGeneric("coef"))

Modified: pkg/R/probe-match.R
===================================================================
--- pkg/R/probe-match.R	2010-11-24 11:03:29 UTC (rev 426)
+++ pkg/R/probe-match.R	2010-11-24 17:35:11 UTC (rev 427)
@@ -93,49 +93,27 @@
   -ll
 }
 
-probe.match <- function(object, start, est = character(0),
-                        probes, weights,
-                        nsim, seed = NULL,
-                        method = c("subplex","Nelder-Mead","SANN"),
-                        verbose = getOption("verbose"), 
-                        eval.only = FALSE, fail.value = NA, ...) {
+probe.match.internal <- function(object, start, est,
+                                 probes, weights,
+                                 nsim, seed,
+                                 method, verbose,
+                                 eval.only, fail.value, ...) {
 
   obj.fn <- neg.synth.loglik
 
-  if (!is(object,"pomp"))
-    stop(sQuote("object")," must be of class ",sQuote("pomp"))
+  if (!is.list(probes)) probes <- list(probes)
 
-  if (missing(start)) start <- coef(object)
-
   if (!eval.only&&(length(est)<1))
     stop("parameters to be estimated must be specified in ",sQuote("est"))
   if (!is.character(est)|!all(est%in%names(start)))
     stop(sQuote("est")," must refer to parameters named in ",sQuote("start"))
   par.index <- which(names(start)%in%est)
   
-  if (missing(probes)) {
-    if (is(object,"probed.pomp"))
-      probes <- object at probes
-    else
-      stop(sQuote("probes")," must be supplied")
-  }
-  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 (missing(nsim)) {
-    if (is(object,"probed.pomp"))
-      nsim <- nrow(object at simvals)
-    else
-      stop(sQuote("nsim")," must be supplied")
-  }
-
-  if (missing(weights)) weights <- 1
-
-  method <- match.arg(method)
-
+  
   params <- start
   guess <- params[par.index]
 
@@ -215,3 +193,126 @@
       msg=as.character(msg)
       )
 }
+
+setGeneric("probe.match",function(object,...)standardGeneric("probe.match"))
+
+setMethod(
+          "probe.match",
+          signature=signature(object="pomp"),
+          function(object, start, est = character(0),
+                   probes, weights,
+                   nsim, seed = NULL,
+                   method = c("subplex","Nelder-Mead","SANN"),
+                   verbose = getOption("verbose"), 
+                   eval.only = FALSE, fail.value = NA, ...) {
+            
+            if (missing(start)) start <- coef(object)
+
+            if (missing(probes))
+              stop(sQuote("probes")," must be supplied")
+
+            if (missing(nsim))
+              stop(sQuote("nsim")," must be supplied")
+
+            if (missing(weights)) weights <- 1
+
+            method <- match.arg(method)
+            
+            probe.match.internal(
+                                 object=object,
+                                 start=start,
+                                 est=est,
+                                 probes=probes,
+                                 weights=weights,
+                                 nsim=nsim,
+                                 seed=seed,
+                                 method=method,
+                                 verbose=verbose,
+                                 eval.only=eval.only,
+                                 fail.value=fail.value,
+                                 ...
+                                 )
+          }
+          )
+
+setMethod(
+          "probe.match",
+          signature=signature(object="probed.pomp"),
+          function(object, start, est = character(0),
+                   probes, weights,
+                   nsim, seed = NULL,
+                   method = c("subplex","Nelder-Mead","SANN"),
+                   verbose = getOption("verbose"), 
+                   eval.only = FALSE, fail.value = NA, ...) {
+            
+            if (missing(start)) start <- coef(object)
+
+            if (missing(probes))
+              probes <- object at probes
+
+            if (missing(nsim))
+              nsim <- nrow(object at simvals)
+            
+            if (missing(weights)) weights <- 1
+
+            method <- match.arg(method)
+            
+            probe.match.internal(
+                                 object=object,
+                                 start=start,
+                                 est=est,
+                                 probes=probes,
+                                 weights=weights,
+                                 nsim=nsim,
+                                 seed=seed,
+                                 method=method,
+                                 verbose=verbose,
+                                 eval.only=eval.only,
+                                 fail.value=fail.value,
+                                 ...
+                                 )
+          }
+          )
+
+setMethod(
+          "probe.match",
+          signature=signature(object="probe.matched.pomp"),
+          function(object, start, est,
+                   probes, weights,
+                   nsim, seed = NULL,
+                   method = c("subplex","Nelder-Mead","SANN"),
+                   verbose = getOption("verbose"), 
+                   eval.only = FALSE, fail.value, ...) {
+            
+            if (missing(start)) start <- coef(object)
+
+            if (missing(est)) est <- object at est
+
+            if (missing(probes))
+              probes <- object at probes
+
+            if (missing(nsim))
+              nsim <- nrow(object at simvals)
+            
+            if (missing(weights)) weights <- 1
+
+            if (missing(fail.value)) fail.value <- object at fail.value
+
+            method <- match.arg(method)
+            
+            probe.match.internal(
+                                 object=object,
+                                 start=start,
+                                 est=est,
+                                 probes=probes,
+                                 weights=weights,
+                                 nsim=nsim,
+                                 seed=seed,
+                                 method=method,
+                                 verbose=verbose,
+                                 eval.only=eval.only,
+                                 fail.value=fail.value,
+                                 ...
+                                 )
+          }
+          )

Modified: pkg/R/traj-match.R
===================================================================
--- pkg/R/traj-match.R	2010-11-24 11:03:29 UTC (rev 426)
+++ pkg/R/traj-match.R	2010-11-24 17:35:11 UTC (rev 427)
@@ -10,9 +10,9 @@
            )
          )
 
-setMethod("$",signature(x="traj.matched.pomp"),function(x, name)slot(x,name))
+setMethod("$",signature=signature(x="traj.matched.pomp"),function(x, name)slot(x,name))
 
-setMethod("logLik",signature(object="traj.matched.pomp"),function(object,...)object at value)
+setMethod("logLik",signature=signature(object="traj.matched.pomp"),function(object, ...)object at value)
 
 setMethod(
           "summary",

Modified: pkg/inst/NEWS
===================================================================
--- pkg/inst/NEWS	2010-11-24 11:03:29 UTC (rev 426)
+++ pkg/inst/NEWS	2010-11-24 17:35:11 UTC (rev 427)
@@ -6,6 +6,8 @@
 
     o  More optimization methods are now provided in 'traj.match'.  These include the new algorithm "sannbox", an optionally box-constrained simulated annealing algorithm.
 
+    o  'probe.match' is now an S4 method (like 'pfilter', 'mif', 'pmcmc', and 'traj.match') with methods for classes 'pomp', 'probed.pomp', and 'probe.matched.pomp'.
+
     o  There is a change to the interface to 'pfilter' in that 'save.states' results in the filling of the 'last.states' slot.  Before version 0.36-1, the 'pfilter' returned a list.  The element 'states' of that list corresponds to the slot 'last.states' in version 0.36-1.  It was necessary to make this name-change in order to avoid a conflict with the 'states' slot inherited from the 'pomp' class.
 
 NEW IN VERSION 0.35-1:

Modified: pkg/man/probe.Rd
===================================================================
--- pkg/man/probe.Rd	2010-11-24 11:03:29 UTC (rev 426)
+++ pkg/man/probe.Rd	2010-11-24 17:35:11 UTC (rev 427)
@@ -7,8 +7,10 @@
 \alias{probe.match}
 \alias{probe.match,pomp-method}
 \alias{probe.match,probed.pomp-method}
+\alias{probe.match,probe.matched.pomp-method}
 \alias{probe.match-pomp}
 \alias{probe.match-probed.pomp}
+\alias{probe.match-probe.matched.pomp}
 \alias{probed.pomp-class}
 \alias{probe.matched.pomp-class}
 \title{Probe a partially-observed Markov process.}
@@ -21,12 +23,24 @@
 \usage{
   \S4method{probe}{pomp}(object, probes, params, nsim, seed = NULL, \dots)
   \S4method{probe}{probed.pomp}(object, probes, params, nsim, seed = NULL, \dots)
-  probe.match(object, start, est = character(0),
+  \S4method{probe.match}{pomp}(object, start, est = character(0),
               probes, weights,
               nsim, seed = NULL,
               method = c("subplex","Nelder-Mead","SANN"),
               verbose = getOption("verbose"), 
               eval.only = FALSE, fail.value = NA, \dots)
+  \S4method{probe.match}{probed.pomp}(object, start, est = character(0),
+              probes, weights,
+              nsim, seed = NULL,
+              method = c("subplex","Nelder-Mead","SANN"),
+              verbose = getOption("verbose"), 
+              eval.only = FALSE, fail.value = NA, \dots)
+  \S4method{probe.match}{probe.matched.pomp}(object, start, est,
+              probes, weights,
+              nsim, seed = NULL,
+              method = c("subplex","Nelder-Mead","SANN"),
+              verbose = getOption("verbose"), 
+              eval.only = FALSE, fail.value, \dots)
 }
 \arguments{
   \item{object}{
@@ -95,8 +109,14 @@
     \item{probes}{list of the probes applied.}
     \item{datvals, simvals}{values of each of the probes applied to the real and simulated data, respectively.}
     \item{quantiles}{fraction of simulations with probe values less than the value of the probe of the data.}
-    \item{pvals}{two-sided p-values: fraction of the \code{simvals} that deviate more extremely from the mean of the \code{simvals} than does \code{datavals}.}
-    \item{synth.loglik}{the log synthetic likelihood (Wood 2010).  This is the likelihood assuming that the probes are multivariate-normally distributed.}
+    \item{pvals}{
+      two-sided p-values:
+      fraction of the \code{simvals} that deviate more extremely from the mean of the \code{simvals} than does \code{datavals}.
+    }
+    \item{synth.loglik}{
+      the log synthetic likelihood (Wood 2010).
+      This is the likelihood assuming that the probes are multivariate-normally distributed.
+    }
   }
 
   \code{probe.match} returns an object of class \code{probe.matched.pomp}, which is derived from class \code{probed.pomp}.



More information about the pomp-commits mailing list