[Pomp-commits] r856 - in pkg/pomp: . R inst man tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 3 23:39:03 CEST 2013
Author: kingaa
Date: 2013-06-03 23:39:03 +0200 (Mon, 03 Jun 2013)
New Revision: 856
Modified:
pkg/pomp/DESCRIPTION
pkg/pomp/NAMESPACE
pkg/pomp/R/pfilter-methods.R
pkg/pomp/inst/NEWS
pkg/pomp/man/pfilter-methods.Rd
pkg/pomp/tests/pfilter.R
pkg/pomp/tests/pfilter.Rout.save
Log:
- add a new 'coerce' method: 'pfilterd.pomp' objects to data-frames
Modified: pkg/pomp/DESCRIPTION
===================================================================
--- pkg/pomp/DESCRIPTION 2013-05-14 19:47:29 UTC (rev 855)
+++ pkg/pomp/DESCRIPTION 2013-06-03 21:39:03 UTC (rev 856)
@@ -1,8 +1,8 @@
Package: pomp
Type: Package
Title: Statistical inference for partially observed Markov processes
-Version: 0.45-1
-Date: 2013-05-14
+Version: 0.45-2
+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: pkg/pomp/NAMESPACE
===================================================================
--- pkg/pomp/NAMESPACE 2013-05-14 19:47:29 UTC (rev 855)
+++ pkg/pomp/NAMESPACE 2013-06-03 21:39:03 UTC (rev 856)
@@ -62,6 +62,7 @@
export(
as.data.frame.pomp,
+ as.data.frame.pfilterd.pomp,
reulermultinom,
deulermultinom,
rgammawn,
Modified: pkg/pomp/R/pfilter-methods.R
===================================================================
--- pkg/pomp/R/pfilter-methods.R 2013-05-14 19:47:29 UTC (rev 855)
+++ pkg/pomp/R/pfilter-methods.R 2013-06-03 21:39:03 UTC (rev 856)
@@ -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: pkg/pomp/inst/NEWS
===================================================================
--- pkg/pomp/inst/NEWS 2013-05-14 19:47:29 UTC (rev 855)
+++ pkg/pomp/inst/NEWS 2013-06-03 21:39:03 UTC (rev 856)
@@ -1,4 +1,7 @@
NEWS
+0.45-2
+ o new method to coerce 'pfilterd.pomp' objects to data-frames.
+
0.45-1
o 'profileDesign' can now handle variables of mixed type.
Modified: pkg/pomp/man/pfilter-methods.Rd
===================================================================
--- pkg/pomp/man/pfilter-methods.Rd 2013-05-14 19:47:29 UTC (rev 855)
+++ pkg/pomp/man/pfilter-methods.Rd 2013-06-03 21:39:03 UTC (rev 856)
@@ -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: pkg/pomp/tests/pfilter.R
===================================================================
--- pkg/pomp/tests/pfilter.R 2013-05-14 19:47:29 UTC (rev 855)
+++ pkg/pomp/tests/pfilter.R 2013-06-03 21:39:03 UTC (rev 856)
@@ -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: pkg/pomp/tests/pfilter.Rout.save
===================================================================
--- pkg/pomp/tests/pfilter.Rout.save 2013-05-14 19:47:29 UTC (rev 855)
+++ pkg/pomp/tests/pfilter.Rout.save 2013-06-03 21:39:03 UTC (rev 856)
@@ -1,7 +1,6 @@
-R version 2.15.2 (2012-10-26) -- "Trick or Treat"
-Copyright (C) 2012 The R Foundation for Statistical Computing
-ISBN 3-900051-07-0
+R version 3.0.1 (2013-05-16) -- "Good Sport"
+Copyright (C) 2013 The R Foundation for Statistical Computing
Platform: x86_64-unknown-linux-gnu (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
@@ -27,6 +26,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
@@ -59,7 +60,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
@@ -67,7 +68,14 @@
6.00e-01 6.50e-02 1.00e-03 9.35e-01
> print(logLik(pf),digits=4)
[1] -945.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()
+null device
+ 1
+>
> proc.time()
user system elapsed
- 5.964 0.056 6.062
+ 6.044 0.104 6.320
More information about the pomp-commits
mailing list