[Pomp-commits] r1031 - pkg/pompExamples/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Dec 19 20:36:46 CET 2014
Author: kingaa
Date: 2014-12-19 20:36:45 +0100 (Fri, 19 Dec 2014)
New Revision: 1031
Added:
pkg/pompExamples/tests/budmoth.R
pkg/pompExamples/tests/budmoth.Rout.save
pkg/pompExamples/tests/examples.R
pkg/pompExamples/tests/pertussis.R
pkg/pompExamples/tests/pertussis.Rout.save
Log:
- put tests directory back in
This reverts commit c2926f7cdf783d51acf9b01c7233fcce5772e089.
Added: pkg/pompExamples/tests/budmoth.R
===================================================================
--- pkg/pompExamples/tests/budmoth.R (rev 0)
+++ pkg/pompExamples/tests/budmoth.R 2014-12-19 19:36:45 UTC (rev 1031)
@@ -0,0 +1,19 @@
+library(pompExamples)
+
+all <- c("food","para1","para2","tri")
+
+bm <- pompExample(budmoth,envir=NULL)
+
+names(bm)
+x <- lapply(bm,as,"data.frame")
+
+print(lapply(x,tail))
+
+y <- simulate(bm$food,seed=3434996L,as.data.frame=TRUE)
+tail(y)
+
+z <- trajectory(bm$tri,as.data.frame=TRUE)
+tail(z)
+
+pf <- pfilter(bm$para1,seed=34348885L,Np=1000)
+logLik(pf)
Added: pkg/pompExamples/tests/budmoth.Rout.save
===================================================================
--- pkg/pompExamples/tests/budmoth.Rout.save (rev 0)
+++ pkg/pompExamples/tests/budmoth.Rout.save 2014-12-19 19:36:45 UTC (rev 1031)
@@ -0,0 +1,130 @@
+
+R version 3.1.2 (2014-10-31) -- "Pumpkin Helmet"
+Copyright (C) 2014 The R Foundation for Statistical Computing
+Platform: x86_64-unknown-linux-gnu (64-bit)
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> library(pompExamples)
+Loading required package: pomp
+Loading required package: subplex
+Loading required package: nloptr
+>
+> all <- c("food","para1","para2","tri")
+>
+> bm <- pompExample(budmoth,envir=NULL)
+>
+> names(bm)
+[1] "food" "para1" "para2" "tri"
+> x <- lapply(bm,as,"data.frame")
+>
+> print(lapply(x,tail))
+$food
+ time Qobs Nobs Sobs Q N S
+56 55 28.90370 20.4806075 2.870679e-05 0.8502012 19.7570009 0.0000257055
+57 56 25.04577 17.2422706 4.340917e-04 0.6794912 14.4355348 0.0005305078
+58 57 21.68427 2.1931554 7.856243e-03 0.6288764 1.9239332 0.0079677582
+59 58 27.25406 0.3103408 1.348361e-02 0.7899212 0.1973302 0.0141600465
+60 59 32.38417 0.1216027 3.499077e-03 0.8898312 0.1200628 0.0032722573
+61 60 32.80127 0.1632687 3.512564e-04 0.9346055 0.1908352 0.0003751743
+ Alpha Lambda A
+56 0.5413771 4.932935 0.8677828
+57 0.5082460 4.851747 1.0428964
+58 0.4871643 4.388592 1.0444642
+59 0.4316777 4.394991 0.9302542
+60 0.5012195 5.063878 1.1726507
+61 0.5703106 4.810311 0.9525775
+
+$para1
+ time Qobs Nobs Sobs Q N S
+56 55 28.45210 0.01658405 0.498973510 0.8126219 0.02020849 0.573040310
+57 56 32.58924 0.27733546 0.018765592 0.9177534 0.17066444 0.022035629
+58 57 33.73454 5.79328447 0.005823772 0.9567875 3.49854944 0.005907819
+59 58 33.57238 46.79128317 0.030243114 0.9456880 56.35560023 0.033871059
+60 59 25.61890 7.50489123 0.791479385 0.7153921 12.65588781 0.871324054
+61 60 26.46555 8.12880629 0.894923272 0.7569961 11.25818628 0.992799332
+ Alpha Lambda A
+56 0.4707325 21.78521 1.754212
+57 0.4377213 21.75771 1.930505
+58 0.5049253 22.14170 1.576733
+59 0.4996302 21.90574 1.675765
+60 0.5157446 21.68244 1.551352
+61 0.4964261 21.93769 1.721177
+
+$para2
+ time Qobs Nobs Sobs Q N S
+56 55 33.87640 15.747819 2.248998e-06 0.9749960 6.921067 2.575005e-06
+57 56 33.94564 50.157117 1.166632e-05 0.9265344 33.878434 1.350848e-05
+58 57 26.54568 39.257279 7.764646e-04 0.7668865 21.145329 1.028206e-03
+59 58 25.06245 37.080107 1.942558e-02 0.7334130 32.430161 2.124212e-02
+60 59 24.65754 10.630755 8.364070e-01 0.6707489 14.812001 9.357010e-01
+61 60 26.63838 2.623661 8.898155e-01 0.7198956 2.691147 9.968919e-01
+ Alpha Lambda A
+56 0.5034550 4.475840 0.7140993
+57 0.4982577 8.622703 0.7018725
+58 0.5168533 9.734355 2.2460464
+59 0.4777904 9.364085 0.9906918
+60 0.5059549 7.138668 6.7705675
+61 0.5120129 10.895242 3.1116150
+
+$tri
+ time Qobs Nobs Sobs Q N S
+56 55 33.36428 5.9679756 3.009644e-06 0.9830185 17.7373560 2.949154e-06
+57 56 29.34035 68.3377210 7.255485e-05 0.8608373 80.4984855 8.681423e-05
+58 57 21.75336 1.2686716 8.552474e-03 0.6310693 0.7176525 9.751675e-03
+59 58 29.15848 0.3500365 1.047452e-02 0.8025905 0.3723865 1.256469e-02
+60 59 32.98213 1.6128525 6.718390e-03 0.8941107 1.0912736 7.410424e-03
+61 60 33.51183 13.0954506 1.173616e-02 0.9378258 7.6959192 1.147648e-02
+ Alpha Lambda A
+56 0.4833379 21.87970 1.738908
+57 0.5010435 22.22843 1.640583
+58 0.5190030 22.45659 1.404177
+59 0.5165432 22.20828 1.810056
+60 0.5183574 22.01444 1.591250
+61 0.4828455 22.35338 1.429722
+
+>
+> y <- simulate(bm$food,seed=3434996L,as.data.frame=TRUE)
+> tail(y)
+ time Qobs Nobs Sobs Q N S
+56 55 24.75707 1.2571930 0.0536837100 0.6960924 0.6909030 0.0655207892
+57 56 29.35042 0.2081742 0.0312580513 0.8328430 0.1516087 0.0367590933
+58 57 29.68381 0.1063595 0.0058573296 0.9128312 0.1262158 0.0061363639
+59 58 33.43385 0.6853961 0.0007332514 0.9501525 0.2684836 0.0007689092
+60 59 32.70001 1.8683455 0.0002049072 0.9684718 0.8167865 0.0002084246
+61 60 33.33550 1.4268639 0.0001321697 0.9644772 2.9148822 0.0001579051
+ Alpha Lambda A sim
+56 0.4386467 5.049427 1.0766197 1
+57 0.4944825 4.972702 0.8273030 1
+58 0.4989262 4.612384 1.1043024 1
+59 0.5386598 5.130300 0.9918653 1
+60 0.4994891 5.038971 1.0048781 1
+61 0.4818151 4.973050 0.9217527 1
+>
+> z <- trajectory(bm$tri,as.data.frame=TRUE)
+> tail(z)
+ Q N S Alpha Lambda A time traj
+56 0.9795835 16.9946885 0.0001199655 0.5 22 1.7 55 1
+57 0.8629557 78.2636478 0.0034591173 0.5 22 1.7 56 1
+58 0.6263889 0.8320401 0.3498223901 0.5 22 1.7 57 1
+59 0.8050102 0.2655329 0.3691104688 0.5 22 1.7 58 1
+60 0.8998638 0.5133800 0.1500321097 0.5 22 1.7 59 1
+61 0.9448503 3.3848665 0.1205147616 0.5 22 1.7 60 1
+>
+> pf <- pfilter(bm$para1,seed=34348885L,Np=1000)
+> logLik(pf)
+[1] 10.68836
+>
+> proc.time()
+ user system elapsed
+ 0.649 0.033 0.670
Added: pkg/pompExamples/tests/examples.R
===================================================================
--- pkg/pompExamples/tests/examples.R (rev 0)
+++ pkg/pompExamples/tests/examples.R 2014-12-19 19:36:45 UTC (rev 1031)
@@ -0,0 +1,24 @@
+library(pompExamples)
+
+set.seed(47575684L)
+
+po <- pompExample(parus,proc="Ricker",meas="lognormal",envir=NULL)
+pf <- pfilter(simulate(po$parus),Np=100,max.fail=Inf)
+tj <- trajectory(po$parus)
+
+po <- pompExample(parus,proc="Ricker",meas="negbin",envir=NULL)
+pf <- pfilter(simulate(po$parus),Np=100,max.fail=Inf)
+
+po <- pompExample(parus,proc="Ricker",meas="Poisson",envir=NULL)
+pf <- pfilter(simulate(po$parus),Np=100,max.fail=Inf)
+
+po <- pompExample(parus,proc="Gompertz",meas="Poisson",envir=NULL)
+pf <- pfilter(simulate(po[[1]]),Np=100,max.fail=Inf)
+tj <- trajectory(po[[1]])
+
+po <- pompExample(parus,proc="Gompertz",meas="lognormal",envir=NULL)
+pf <- pfilter(simulate(po$parus),Np=100,max.fail=Inf)
+
+pompExample(bbp)
+pf <- pfilter(simulate(bbp),Np=100,max.fail=Inf)
+tj <- trajectory(bbp)
Added: pkg/pompExamples/tests/pertussis.R
===================================================================
--- pkg/pompExamples/tests/pertussis.R (rev 0)
+++ pkg/pompExamples/tests/pertussis.R 2014-12-19 19:36:45 UTC (rev 1031)
@@ -0,0 +1,37 @@
+library(pompExamples)
+
+all <- c("SEIR.small","SEIR.big","SEIRS.small","SEIRS.big","SEIRR.small","SEIRR.big","full.small","full.big")
+
+sapply(all,function(n)eval(bquote(pertussis.sim(.(n))))) -> pt
+
+names(pt)
+x <- lapply(pt,as.data.frame)
+
+print(lapply(x,tail))
+
+x <- simulate(pertussis.sim(full.big),seed=395885L,as.data.frame=TRUE)
+tail(x)
+
+y <- trajectory(pertussis.sim(SEIRS.small),as.data.frame=TRUE)
+tail(y)
+
+system.time(pf <- pfilter(pertussis.sim(full.small),seed=3445886L,Np=1000))
+logLik(pf)
+
+pttest <- function (po, digits = 15) {
+ identical(
+ signif(coef(po),digits=digits),
+ signif(partrans(po,partrans(po,coef(po),dir='inv'),dir='for'),digits=digits)
+ )
+}
+
+stopifnot(all(sapply(pt,pttest)))
+
+pttest <- function (po, digits = 15) {
+ identical(
+ signif(coef(po,trans=T),digits=digits),
+ signif(partrans(po,partrans(po,coef(po,trans=T),dir='f'),dir='inv'),digits=digits)
+ )
+}
+
+stopifnot(all(sapply(pt,pttest)))
Added: pkg/pompExamples/tests/pertussis.Rout.save
===================================================================
--- pkg/pompExamples/tests/pertussis.Rout.save (rev 0)
+++ pkg/pompExamples/tests/pertussis.Rout.save 2014-12-19 19:36:45 UTC (rev 1031)
@@ -0,0 +1,173 @@
+
+R Under development (unstable) (2014-12-14 r67168) -- "Unsuffered Consequences"
+Copyright (C) 2014 The R Foundation for Statistical Computing
+Platform: x86_64-unknown-linux-gnu (64-bit)
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> library(pompExamples)
+Loading required package: pomp
+Loading required package: subplex
+Loading required package: nloptr
+>
+> all <- c("SEIR.small","SEIR.big","SEIRS.small","SEIRS.big","SEIRR.small","SEIRR.big","full.small","full.big")
+>
+> sapply(all,function(n)eval(bquote(pertussis.sim(.(n))))) -> pt
+>
+> names(pt)
+[1] "SEIR.small" "SEIR.big" "SEIRS.small" "SEIRS.big" "SEIRR.small"
+[6] "SEIRR.big" "full.small" "full.big"
+> x <- lapply(pt,as.data.frame)
+>
+> print(lapply(x,tail))
+$SEIR.small
+ time reports S E I R1 R2 cases W err simpop
+1036 19.90385 70 26873 244 409 472429 0 225 0 7 499955
+1037 19.92308 69 26810 239 435 472458 0 221 0 7 499942
+1038 19.94231 54 26797 244 435 472497 0 208 0 7 499973
+1039 19.96154 46 26746 274 417 472542 0 205 0 7 499979
+1040 19.98077 53 26709 256 450 472538 0 228 0 7 499953
+1041 20.00000 71 26679 273 415 472560 0 183 0 7 499927
+
+$SEIR.big
+ time reports S E I R1 R2 cases W err simpop
+1036 19.90385 520 255547 1703 2917 4739686 0 1470 0 7 4999853
+1037 19.92308 484 255784 1759 3003 4739211 0 1489 0 7 4999757
+1038 19.94231 406 256081 1856 2995 4738900 0 1444 0 7 4999832
+1039 19.96154 533 256320 1869 3129 4738606 0 1597 0 7 4999924
+1040 19.98077 425 256551 1879 3164 4738317 0 1545 0 7 4999911
+1041 20.00000 412 257106 1639 3151 4738010 0 1495 0 7 4999906
+
+$SEIRS.small
+ time reports S E I R1 R2 cases W err simpop
+1036 19.90385 47 80392 539 920 228000 190629 467 0 7 500480
+1037 19.92308 41 80392 578 909 227952 190651 431 0 7 500482
+1038 19.94231 49 80395 591 914 227879 190690 464 0 7 500469
+1039 19.96154 67 80471 575 975 227795 190660 500 0 7 500476
+1040 19.98077 42 80516 553 993 227732 190669 513 0 7 500463
+1041 20.00000 61 80660 492 986 227653 190677 461 0 7 500468
+
+$SEIRS.big
+ time reports S E I R1 R2 cases W err simpop
+1036 19.90385 489 773965 5409 9193 2299336 1912393 4484 0 7 5000296
+1037 19.92308 568 774652 5472 9318 2298462 1912401 4574 0 7 5000305
+1038 19.94231 397 775170 5539 9426 2297714 1912390 4671 0 7 5000239
+1039 19.96154 411 775614 5740 9491 2297059 1912330 4609 0 7 5000234
+1040 19.98077 442 776437 5571 9697 2296283 1912273 4748 0 7 5000261
+1041 20.00000 518 778090 4858 9441 2295594 1912196 4335 0 7 5000179
+
+$SEIRR.small
+ time reports S E I R1 R2 cases W err simpop
+1036 19.90385 73 64537 864 1441 317687 115760 714 0 7 500289
+1037 19.92308 69 64260 896 1502 318088 115525 758 0 7 500271
+1038 19.94231 76 63954 981 1543 318494 115282 748 0 7 500254
+1039 19.96154 84 63664 965 1638 318953 115037 836 0 7 500257
+1040 19.98077 91 63373 992 1670 319485 114723 802 0 7 500243
+1041 20.00000 81 63266 861 1646 319863 114604 760 0 7 500240
+
+$SEIRR.big
+ time reports S E I R1 R2 cases W err simpop
+1036 19.90385 481 641670 4792 7924 3195207 1153657 3925 0 7 5003250
+1037 19.92308 379 642044 5038 8097 3193839 1154198 4018 0 7 5003216
+1038 19.94231 541 642462 5084 8425 3192769 1154480 4217 0 7 5003220
+1039 19.96154 577 642681 5221 8605 3192041 1154729 4331 0 7 5003277
+1040 19.98077 437 643030 5160 8849 3191258 1155014 4418 0 7 5003311
+1041 20.00000 400 644214 4588 8562 3189940 1155983 3884 0 7 5003287
+
+$full.small
+ time reports S E I R1 R2 cases W err simpop
+1036 19.90385 38 60812 492 892 330814 107242 437 -9.164189 7 500252
+1037 19.92308 35 60904 514 881 330659 107326 413 -9.153313 7 500284
+1038 19.94231 44 60988 464 873 330490 107453 420 -9.279501 7 500268
+1039 19.96154 46 61032 517 876 330295 107543 398 -9.092366 7 500263
+1040 19.98077 39 61122 504 845 330138 107631 403 -9.103926 7 500240
+1041 20.00000 43 61258 474 820 329898 107806 384 -8.973250 7 500256
+
+$full.big
+ time reports S E I R1 R2 cases W err
+1036 19.90385 319 624607 4552 7566 3278019 1088429 3664 -4.654307 7
+1037 19.92308 372 625824 4363 7590 3275577 1089789 3677 -4.795999 7
+1038 19.94231 348 626800 4490 7621 3273350 1090834 3689 -4.774106 7
+1039 19.96154 377 628074 4334 7672 3271128 1091904 3713 -4.848567 7
+1040 19.98077 331 629454 4185 7381 3268762 1093266 3431 -5.014912 7
+1041 20.00000 367 631218 3705 7153 3265743 1095129 3306 -4.966009 7
+ simpop
+1036 5003173
+1037 5003143
+1038 5003095
+1039 5003112
+1040 5003048
+1041 5002948
+
+>
+> x <- simulate(pertussis.sim(full.big),seed=395885L,as.data.frame=TRUE)
+> tail(x)
+ time reports S E I R1 R2 cases W err
+1036 19.90385 432 662434 5677 9458 3201351 1118149 4831 -0.4801610 7
+1037 19.92308 524 662819 5615 9625 3200616 1118455 4737 -0.6165661 7
+1038 19.94231 396 662918 5888 9754 3200171 1118414 4831 -0.5954462 7
+1039 19.96154 515 663272 5698 9925 3199550 1118678 4928 -0.7923733 7
+1040 19.98077 504 663479 5812 9991 3198989 1118914 4782 -0.8369185 7
+1041 20.00000 529 664560 5030 9867 3197787 1119969 4609 -0.8803061 7
+ simpop sim
+1036 4997069 1
+1037 4997130 1
+1038 4997145 1
+1039 4997123 1
+1040 4997185 1
+1041 4997213 1
+>
+> y <- trajectory(pertussis.sim(SEIRS.small),as.data.frame=TRUE)
+> tail(y)
+ S E I R1 R2 cases W err simpop
+1036 81409.73 558.4599 942.3100 227353.0 189736.5 487.2963 0 0 5e+05
+1037 81420.36 573.0107 965.5155 227305.3 189735.8 500.4770 0 0 5e+05
+1038 81418.14 587.5604 989.6877 227269.6 189735.0 513.3168 0 0 5e+05
+1039 81402.73 602.3328 1014.5493 227246.2 189734.2 526.2802 0 0 5e+05
+1040 81415.22 580.7639 1035.4780 227235.2 189733.4 534.7187 0 0 5e+05
+1041 81532.40 510.2405 1002.6699 227222.2 189732.5 478.9785 0 0 5e+05
+ time traj
+1036 19.90385 1
+1037 19.92308 1
+1038 19.94231 1
+1039 19.96154 1
+1040 19.98077 1
+1041 20.00000 1
+>
+> system.time(pf <- pfilter(pertussis.sim(full.small),seed=3445886L,Np=1000))
+ user system elapsed
+ 17.801 0.004 17.861
+> logLik(pf)
+[1] -3829.33
+>
+> pttest <- function (po, digits = 15) {
++ identical(
++ signif(coef(po),digits=digits),
++ signif(partrans(po,partrans(po,coef(po),dir='inv'),dir='for'),digits=digits)
++ )
++ }
+>
+> stopifnot(all(sapply(pt,pttest)))
+>
+> pttest <- function (po, digits = 15) {
++ identical(
++ signif(coef(po,trans=T),digits=digits),
++ signif(partrans(po,partrans(po,coef(po,trans=T),dir='f'),dir='inv'),digits=digits)
++ )
++ }
+>
+> stopifnot(all(sapply(pt,pttest)))
+>
+> proc.time()
+ user system elapsed
+ 18.657 0.060 18.801
More information about the pomp-commits
mailing list