[Pomp-commits] r857 - in branches/premif2: . R inst man tests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Jun 4 13:54:01 CEST 2013


Author: kingaa
Date: 2013-06-04 13:54:01 +0200 (Tue, 04 Jun 2013)
New Revision: 857

Modified:
   branches/premif2/DESCRIPTION
   branches/premif2/NAMESPACE
   branches/premif2/R/pfilter-methods.R
   branches/premif2/inst/NEWS
   branches/premif2/man/pfilter-methods.Rd
   branches/premif2/tests/pfilter.R
   branches/premif2/tests/pfilter.Rout.save
Log:
- add a new 'coerce' method: 'pfilterd.pomp' objects to data-frames



Modified: branches/premif2/DESCRIPTION
===================================================================
--- branches/premif2/DESCRIPTION	2013-06-03 21:39:03 UTC (rev 856)
+++ branches/premif2/DESCRIPTION	2013-06-04 11:54:01 UTC (rev 857)
@@ -1,8 +1,8 @@
 Package: pomp
 Type: Package
 Title: Statistical inference for partially observed Markov processes
-Version: 0.43-8
-Date: 2013-04-16
+Version: 0.43-9
+Date: 2013-06-03
 Maintainer: Aaron A. King <kingaa at umich.edu>
 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: branches/premif2/NAMESPACE
===================================================================
--- branches/premif2/NAMESPACE	2013-06-03 21:39:03 UTC (rev 856)
+++ branches/premif2/NAMESPACE	2013-06-04 11:54:01 UTC (rev 857)
@@ -62,6 +62,7 @@
 
 export(
        as.data.frame.pomp,
+       as.data.frame.pfilterd.pomp,
        reulermultinom,
        deulermultinom,
        rgammawn,

Modified: branches/premif2/R/pfilter-methods.R
===================================================================
--- branches/premif2/R/pfilter-methods.R	2013-06-03 21:39:03 UTC (rev 856)
+++ branches/premif2/R/pfilter-methods.R	2013-06-04 11:54:01 UTC (rev 857)
@@ -3,6 +3,31 @@
 setMethod("eff.sample.size",signature(object="pfilterd.pomp"),function(object,...)object at eff.sample.size)
 setMethod("cond.logLik",signature(object="pfilterd.pomp"),function(object,...)object at cond.loglik)
 
+## 'coerce' method: allows for coercion of a "pomp" object to a data-frame
+setAs(
+      from="pfilterd.pomp",
+      to="data.frame",
+      def = function (from) {
+        pm <- pred.mean(from)
+        pv <- pred.var(from)
+        fm <- filter.mean(from)
+        out <- cbind(
+                     as(as(from,"pomp"),"data.frame"),
+                     ess=eff.sample.size(from),
+                     cond.loglik=cond.logLik(from)
+                     )
+        if (length(pm)>0)
+          out <- cbind(out,pred.mean=t(pm))
+        if (length(pv)>0)
+          out <- cbind(out,pred.var=t(pv))
+        if (length(fm)>0)
+          out <- cbind(out,filter.mean=t(fm))
+        out
+      }
+      )
+
+as.data.frame.pfilterd.pomp <- function (x, row.names, optional, ...) as(x,"data.frame")
+
 ## extract the prediction means
 setMethod(
           "pred.mean",

Modified: branches/premif2/inst/NEWS
===================================================================
--- branches/premif2/inst/NEWS	2013-06-03 21:39:03 UTC (rev 856)
+++ branches/premif2/inst/NEWS	2013-06-04 11:54:01 UTC (rev 857)
@@ -1,4 +1,7 @@
 NEWS
+0.43-9
+     o	new method to coerce 'pfilterd.pomp' objects to data-frames.
+
 0.43-4
      o	Clean up tests.
 

Modified: branches/premif2/man/pfilter-methods.Rd
===================================================================
--- branches/premif2/man/pfilter-methods.Rd	2013-06-03 21:39:03 UTC (rev 856)
+++ branches/premif2/man/pfilter-methods.Rd	2013-06-04 11:54:01 UTC (rev 857)
@@ -18,6 +18,8 @@
 \alias{cond.logLik}
 \alias{cond.logLik,pfilterd.pomp-method}
 \alias{cond.logLik-pfilterd.pomp}
+\alias{as,pfilterd.pomp-method}
+\alias{coerce,pfilterd.pomp,data.frame-method}
 \title{Methods of the "pfilterd.pomp" class}
 \description{Methods of the "pfilterd.pomp" class.}
 \usage{
@@ -27,12 +29,24 @@
 \S4method{filter.mean}{pfilterd.pomp}(object, pars, \dots)
 \S4method{eff.sample.size}{pfilterd.pomp}(object, \dots)
 \S4method{cond.logLik}{pfilterd.pomp}(object, \dots)
+\S4method{as}{pfilterd.pomp}(object, class)
+\S4method{coerce}{pfilterd.pomp,data.frame}(from, to = "data.frame", strict = TRUE)
 }
 \arguments{
   \item{object}{
     An object of class \code{pfilterd.pomp} or inheriting class \code{pfilterd.pomp}.
   }
   \item{pars}{Names of parameters.}
+  \item{class}{
+    character;
+    name of the class to which \code{object} should be coerced.
+  }
+  \item{from, to}{
+    the classes between which coercion should be performed.
+  }
+  \item{strict}{
+    ignored.
+  }
   \item{\dots}{
     Additional arguments unused at present.
   }

Modified: branches/premif2/tests/pfilter.R
===================================================================
--- branches/premif2/tests/pfilter.R	2013-06-03 21:39:03 UTC (rev 856)
+++ branches/premif2/tests/pfilter.R	2013-06-04 11:54:01 UTC (rev 857)
@@ -4,6 +4,8 @@
 
 set.seed(9994847L)
 
+pdf(file="pfilter.pdf")
+
 pf <- pfilter(ou2,Np=1000,seed=343439L)
 print(coef(ou2,c('x1.0','x2.0','alpha.1','alpha.4')),digits=4)
 cat("particle filter log likelihood at truth\n")
@@ -23,6 +25,11 @@
 p <- coef(euler.sir)
 euler.sir at params <- numeric(0)
 p["iota"] <- 1
-pf <- pfilter(euler.sir,params=p,Np=100,seed=394343L)
+pf <- pfilter(euler.sir,params=p,Np=100,seed=394343L,filter.mean=TRUE)
 print(coef(pf))
 print(logLik(pf),digits=4)
+plot(cond.loglik~time,data=as(pf,"data.frame"),type='l')
+plot(ess~time,data=as(pf,"data.frame"),type='l')
+plot(filter.mean.I~time,data=as(pf,"data.frame"),type='l')
+
+dev.off()

Modified: branches/premif2/tests/pfilter.Rout.save
===================================================================
--- branches/premif2/tests/pfilter.Rout.save	2013-06-03 21:39:03 UTC (rev 856)
+++ branches/premif2/tests/pfilter.Rout.save	2013-06-04 11:54:01 UTC (rev 857)
@@ -24,6 +24,8 @@
 > 
 > set.seed(9994847L)
 > 
+> pdf(file="pfilter.pdf")
+> 
 > pf <- pfilter(ou2,Np=1000,seed=343439L)
 > print(coef(ou2,c('x1.0','x2.0','alpha.1','alpha.4')),digits=4)
    x1.0    x2.0 alpha.1 alpha.4 
@@ -54,7 +56,7 @@
 > p <- coef(euler.sir)
 > euler.sir at params <- numeric(0)
 > p["iota"] <- 1
-> pf <- pfilter(euler.sir,params=p,Np=100,seed=394343L)
+> pf <- pfilter(euler.sir,params=p,Np=100,seed=394343L,filter.mean=TRUE)
 > print(coef(pf))
    gamma       mu     iota    beta1    beta2    beta3  beta.sd      pop 
 2.60e+01 2.00e-02 1.00e+00 4.00e+02 4.80e+02 3.20e+02 1.00e-03 2.10e+06 



More information about the pomp-commits mailing list