[Pomp-commits] r1011 - pkg/pomp/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 23 21:23:13 CEST 2014
Author: kingaa
Date: 2014-09-23 21:23:13 +0200 (Tue, 23 Sep 2014)
New Revision: 1011
Modified:
pkg/pomp/tests/bbs.R
pkg/pomp/tests/bbs.Rout.save
pkg/pomp/tests/ou2-bsmc2.Rout.save
Log:
- update tests that use 'bsmc2'
Modified: pkg/pomp/tests/bbs.R
===================================================================
--- pkg/pomp/tests/bbs.R 2014-09-23 19:23:08 UTC (rev 1010)
+++ pkg/pomp/tests/bbs.R 2014-09-23 19:23:13 UTC (rev 1011)
@@ -15,9 +15,13 @@
}
)
-fit1 <- bsmc2(bbs,params=coef(bbs),Np=5000,transform=TRUE,
- est=c("beta","sigma"),smooth=0.2)
+fit1 <- bsmc(bbs,params=coef(bbs),Np=1000,ntries=5,transform=TRUE,
+ est=c("beta","sigma"),smooth=0.2)
signif(coef(fit1),3)
-fit2 <- traj.match(bbs,est=c("beta","sigma"),transform=TRUE)
+fit2 <- bsmc2(bbs,params=coef(bbs),Np=5000,transform=TRUE,
+ est=c("beta","sigma"),smooth=0.2)
signif(coef(fit2),3)
+
+fit3 <- traj.match(bbs,est=c("beta","sigma"),transform=TRUE)
+signif(coef(fit3),3)
Modified: pkg/pomp/tests/bbs.Rout.save
===================================================================
--- pkg/pomp/tests/bbs.Rout.save 2014-09-23 19:23:08 UTC (rev 1010)
+++ pkg/pomp/tests/bbs.Rout.save 2014-09-23 19:23:13 UTC (rev 1011)
@@ -16,12 +16,8 @@
Type 'q()' to quit R.
> library(pomp)
-Loading required package: mvtnorm
Loading required package: subplex
Loading required package: nloptr
-Loading required package: deSolve
-Loading required package: coda
-Loading required package: lattice
>
> pompExample(bbs)
newly created pomp object(s):
@@ -48,20 +44,29 @@
+ }
+ )
>
-> fit1 <- bsmc(bbs,params=coef(bbs),Np=1000,transform=TRUE,est=c("beta","sigma"),smooth=0.2)
+> fit1 <- bsmc(bbs,params=coef(bbs),Np=1000,ntries=5,transform=TRUE,
++ est=c("beta","sigma"),smooth=0.2)
> signif(coef(fit1),3)
gamma mu iota beta beta.sd pop rho sigma
- 0.333 0.000 0.000 4.300 0.000 1400.000 0.900 2.050
+ 0.333 0.000 0.000 3.570 0.000 1400.000 0.900 1.920
S.0 I.0 R.0
0.999 0.001 0.000
>
-> fit2 <- traj.match(bbs,est=c("beta","sigma"),transform=TRUE)
+> fit2 <- bsmc2(bbs,params=coef(bbs),Np=5000,transform=TRUE,
++ est=c("beta","sigma"),smooth=0.2)
> signif(coef(fit2),3)
gamma mu iota beta beta.sd pop rho sigma
+ 0.333 0.000 0.000 3.670 0.000 1400.000 0.900 1.940
+ S.0 I.0 R.0
+ 0.999 0.001 0.000
+>
+> fit3 <- traj.match(bbs,est=c("beta","sigma"),transform=TRUE)
+> signif(coef(fit3),3)
+ gamma mu iota beta beta.sd pop rho sigma
0.333 0.000 0.000 2.090 0.000 1400.000 0.900 0.474
S.0 I.0 R.0
0.999 0.001 0.000
>
> proc.time()
user system elapsed
- 2.957 0.036 2.983
+ 6.716 0.076 6.831
Modified: pkg/pomp/tests/ou2-bsmc2.Rout.save
===================================================================
--- pkg/pomp/tests/ou2-bsmc2.Rout.save 2014-09-23 19:23:08 UTC (rev 1010)
+++ pkg/pomp/tests/ou2-bsmc2.Rout.save 2014-09-23 19:23:13 UTC (rev 1011)
@@ -26,7 +26,7 @@
>
> time(ou2) <- 1:10
>
-> Np <- 10000
+> Np <- 50000
>
> prior.bounds <- rbind(
+ alpha.2=c(-0.55,-0.45),
@@ -44,22 +44,19 @@
>
> ##Run Liu & West particle filter
> tic <- Sys.time()
-> smc <- bsmc(
-+ ou2,
-+ params=prior,
-+ est=estnames,
-+ ntries=5,
-+ smooth=0.02,
-+ lower=prior.bounds[estnames,"lower"],
-+ upper=prior.bounds[estnames,"upper"]
-+ )
+> smc <- bsmc2(
++ ou2,
++ params=prior,
++ est=estnames,
++ smooth=0.02
++ )
> toc <- Sys.time()
>
> prior <- smc$prior
> post <- smc$post
>
> print(etime <- toc-tic)
-Time difference of 2.931616 secs
+Time difference of 2.042303 secs
>
> print(
+ cbind(
@@ -71,8 +68,8 @@
+ )
prior.mean posterior.mean truth 2.5% 50% 97.5%
alpha.1 0.8000000 0.8000000 0.8 0.8000000 0.8000000 0.8000000
-alpha.2 -0.4999287 -0.5105023 -0.5 -0.5402483 -0.4993459 -0.4536930
-alpha.3 0.2996065 0.3148637 0.3 0.2823821 0.3260754 0.3388949
+alpha.2 -0.4999934 -0.5041799 -0.5 -0.5484110 -0.5061110 -0.4524724
+alpha.3 0.2998071 0.3015016 0.3 0.2526553 0.3020846 0.3478032
alpha.4 0.9000000 0.9000000 0.9 0.9000000 0.9000000 0.9000000
sigma.1 3.0000000 3.0000000 3.0 3.0000000 3.0000000 3.0000000
sigma.2 -0.5000000 -0.5000000 -0.5 -0.5000000 -0.5000000 -0.5000000
@@ -82,9 +79,9 @@
x2.0 4.0000000 4.0000000 4.0 4.0000000 4.0000000 4.0000000
>
> print(min(smc$eff.sample.size))
-[1] 22.94863
+[1] 3362.331
> print(smc$log.evidence)
-[1] 45.47584
+[1] -44.40479
>
> ou2 <- pomp(ou2,
+ rprior=function(params,...){
@@ -92,13 +89,13 @@
+ }
+ )
>
-> smc <- bsmc(ou2,ntries=5,Np=5000,smooth=0.1,est=estnames,seed=648651945L)
+> smc <- bsmc2(ou2,Np=25000,smooth=0.1,est=estnames,seed=648651945L)
> print(smc$eff.sample.size)
- [1] 186.40437 36.29100 57.56951 29.30424 180.23722 34.63366 156.94264
- [8] 24.49006 178.39269 125.05970
+ [1] 6022.591 3916.624 3039.755 3240.052 5532.814 1832.363 4933.092 1598.452
+ [9] 5047.793 3816.342
> print(smc$log.evidence)
-[1] 37.68127
+[1] -44.37704
>
> proc.time()
user system elapsed
- 4.908 0.068 5.011
+ 3.576 0.104 3.707
More information about the pomp-commits
mailing list